From 022be217a2e345e9ed391d0a2d0b9f25fcc3014d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 28 Dec 2019 15:57:36 -0500 Subject: [PATCH] Remove ==, not==, and order[<,<=,>,>=]. This unifies equality and comparison checking. Before, we had separate functions and vm opcodes for comparing general values vs. for comparing numbers, where the numberic functions were polymorphic and had special cases for handling NaNs. By unfiying them, abstract types can now better integrate with other number types and behave as keys. For now, the old functions are aliased but will eventually be removed. --- CHANGELOG.md | 5 ++++ src/boot/boot.janet | 24 ++++++++++++------- src/core/asm.c | 7 ++---- src/core/bytecode.c | 7 ++---- src/core/cfuns.c | 36 +++++------------------------ src/core/compile.h | 22 +++++++----------- src/core/corelib.c | 38 +++++++----------------------- src/core/inttypes.c | 30 ++++++++++++++++++++---- src/core/io.c | 2 ++ src/core/math.c | 2 ++ src/core/parse.c | 2 ++ src/core/peg.c | 2 ++ src/core/thread.c | 2 ++ src/core/typedarray.c | 4 ++++ src/core/util.c | 2 ++ src/core/value.c | 51 ++++++++++++++++++++++++++++------------ src/core/vm.c | 54 ++++++++++++++++++++++--------------------- src/include/janet.h | 9 ++++---- test/suite0.janet | 24 +++++++++---------- test/suite1.janet | 10 ++++---- test/suite6.janet | 14 +++++------ 21 files changed, 181 insertions(+), 166 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5e905783..3571892f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,11 @@ All notable changes to this project will be documented in this file. ### Unreleased +- Remove `==`, `not==`, `order<`, `order>`, `order<=`, and `order>=`. Instead, use the normal + comparison and equality functions. +- Let abstract types define a hash function and comparison/equality semantics. This lets + abstract types much better represent value types. This adds more fields to abstract types, which + will generate warnings when compiled against other versions. - Update documentation. ### 1.6.0 - 2019-12-22 diff --git a/src/boot/boot.janet b/src/boot/boot.janet index bd1ce0bf..b226c62b 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -72,14 +72,22 @@ (setdyn name* @{:ref @[init]}) nil) +# Aliases +(def == =) +(def not== ==) +(def order< <) +(def order<= <=) +(def order> >=) +(def order>= >=) + # Basic predicates (defn nan? "Check if x is NaN" [x] (not= x x)) -(defn even? "Check if x is even." [x] (== 0 (% x 2))) +(defn even? "Check if x is even." [x] (= 0 (% x 2))) (defn odd? "Check if x is odd." [x] (not= 0 (% x 2))) -(defn zero? "Check if x is zero." [x] (== x 0)) +(defn zero? "Check if x is zero." [x] (= x 0)) (defn pos? "Check if x is greater than 0." [x] (> x 0)) (defn neg? "Check if x is less than 0." [x] (< x 0)) -(defn one? "Check if x is equal to 1." [x] (== x 1)) +(defn one? "Check if x is equal to 1." [x] (= x 1)) (defn number? "Check if x is a number." [x] (= (type x) :number)) (defn fiber? "Check if x is a fiber." [x] (= (type x) :fiber)) (defn string? "Check if x is a string." [x] (= (type x) :string)) @@ -554,12 +562,12 @@ (defn max-order "Returns the maximum of the arguments according to a total order over all values." - [& args] (extreme order> args)) + [& args] (extreme > args)) (defn min-order "Returns the minimum of the arguments according to a total order over all values." - [& args] (extreme order< args)) + [& args] (extreme < args)) (defn first "Get the first element from an indexed data structure." @@ -605,11 +613,11 @@ a) (fn sort [a &opt by] - (sort-help a 0 (- (length a) 1) (or by order<))))) + (sort-help a 0 (- (length a) 1) (or by <))))) (defn sorted "Returns a new sorted array without modifying the old one." - [ind by] + [ind &opt by] (sort (array/slice ind) by)) (defn reduce @@ -1427,7 +1435,7 @@ (if-let [[path line col] sm] (string " " path " on line " line ", column " col "\n") "") (if (or d sm) "\n" "") - (if d (doc-format d) "no documentation found.") + (if d (doc-format d) " no documentation found.") "\n\n")))) # else diff --git a/src/core/asm.c b/src/core/asm.c index 9247ff8b..77afd053 100644 --- a/src/core/asm.c +++ b/src/core/asm.c @@ -77,14 +77,12 @@ static const JanetInstructionDef janet_ops[] = { {"divim", JOP_DIVIDE_IMMEDIATE}, {"eq", JOP_EQUALS}, {"eqim", JOP_EQUALS_IMMEDIATE}, - {"eqn", JOP_NUMERIC_EQUAL}, {"err", JOP_ERROR}, {"get", JOP_GET}, {"geti", JOP_GET_INDEX}, {"gt", JOP_GREATER_THAN}, - {"gten", JOP_NUMERIC_GREATER_THAN_EQUAL}, + {"gte", JOP_GREATER_THAN_EQUAL}, {"gtim", JOP_GREATER_THAN_IMMEDIATE}, - {"gtn", JOP_NUMERIC_GREATER_THAN}, {"in", JOP_IN}, {"jmp", JOP_JUMP}, {"jmpif", JOP_JUMP_IF}, @@ -98,9 +96,8 @@ static const JanetInstructionDef janet_ops[] = { {"ldu", JOP_LOAD_UPVALUE}, {"len", JOP_LENGTH}, {"lt", JOP_LESS_THAN}, - {"lten", JOP_NUMERIC_LESS_THAN_EQUAL}, + {"lte", JOP_LESS_THAN_EQUAL}, {"ltim", JOP_LESS_THAN_IMMEDIATE}, - {"ltn", JOP_NUMERIC_LESS_THAN}, {"mkarr", JOP_MAKE_ARRAY}, {"mkbtp", JOP_MAKE_BRACKET_TUPLE}, {"mkbuf", JOP_MAKE_BUFFER}, diff --git a/src/core/bytecode.c b/src/core/bytecode.c index 13bb6b3f..bba153b4 100644 --- a/src/core/bytecode.c +++ b/src/core/bytecode.c @@ -93,11 +93,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = { JINT_S, /* JOP_MAKE_TABLE */ JINT_S, /* JOP_MAKE_TUPLE */ JINT_S, /* JOP_MAKE_BRACKET_TUPLE */ - JINT_SSS, /* JOP_NUMERIC_LESS_THAN */ - JINT_SSS, /* JOP_NUMERIC_LESS_THAN_EQUAL */ - JINT_SSS, /* JOP_NUMERIC_GREATER_THAN */ - JINT_SSS, /* JOP_NUMERIC_GREATER_THAN_EQUAL */ - JINT_SSS /* JOP_NUMERIC_EQUAL */ + JINT_SSS, /* JOP_GREATER_THAN_EQUAL */ + JINT_SSS /* JOP_LESS_THAN_EQUAL */ }; /* Verify some bytecode */ diff --git a/src/core/cfuns.c b/src/core/cfuns.c index f0e83662..8be8ec08 100644 --- a/src/core/cfuns.c +++ b/src/core/cfuns.c @@ -235,41 +235,23 @@ static JanetSlot compreduce( return t; } -static JanetSlot do_order_gt(JanetFopts opts, JanetSlot *args) { +static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) { return compreduce(opts, args, JOP_GREATER_THAN, 0); } -static JanetSlot do_order_lt(JanetFopts opts, JanetSlot *args) { +static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) { return compreduce(opts, args, JOP_LESS_THAN, 0); } -static JanetSlot do_order_gte(JanetFopts opts, JanetSlot *args) { - return compreduce(opts, args, JOP_LESS_THAN, 1); -} -static JanetSlot do_order_lte(JanetFopts opts, JanetSlot *args) { - return compreduce(opts, args, JOP_GREATER_THAN, 1); -} -static JanetSlot do_order_eq(JanetFopts opts, JanetSlot *args) { - return compreduce(opts, args, JOP_EQUALS, 0); -} -static JanetSlot do_order_neq(JanetFopts opts, JanetSlot *args) { - return compreduce(opts, args, JOP_EQUALS, 1); -} -static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) { - return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN, 0); -} -static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) { - return compreduce(opts, args, JOP_NUMERIC_LESS_THAN, 0); -} static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) { - return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN_EQUAL, 0); + return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0); } static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) { - return compreduce(opts, args, JOP_NUMERIC_LESS_THAN_EQUAL, 0); + return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0); } static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) { - return compreduce(opts, args, JOP_NUMERIC_EQUAL, 0); + return compreduce(opts, args, JOP_EQUALS, 0); } static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) { - return compreduce(opts, args, JOP_NUMERIC_EQUAL, 1); + return compreduce(opts, args, JOP_EQUALS, 1); } /* Arranged by tag */ @@ -293,12 +275,6 @@ static const JanetFunOptimizer optimizers[] = { {NULL, do_rshift}, {NULL, do_rshiftu}, {fixarity1, do_bnot}, - {NULL, do_order_gt}, - {NULL, do_order_lt}, - {NULL, do_order_gte}, - {NULL, do_order_lte}, - {NULL, do_order_eq}, - {NULL, do_order_neq}, {NULL, do_gt}, {NULL, do_lt}, {NULL, do_gte}, diff --git a/src/core/compile.h b/src/core/compile.h index a458e2d4..3662c5f1 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -48,20 +48,14 @@ #define JANET_FUN_RSHIFT 17 #define JANET_FUN_RSHIFTU 18 #define JANET_FUN_BNOT 19 -#define JANET_FUN_ORDER_GT 20 -#define JANET_FUN_ORDER_LT 21 -#define JANET_FUN_ORDER_GTE 22 -#define JANET_FUN_ORDER_LTE 23 -#define JANET_FUN_ORDER_EQ 24 -#define JANET_FUN_ORDER_NEQ 25 -#define JANET_FUN_GT 26 -#define JANET_FUN_LT 27 -#define JANET_FUN_GTE 28 -#define JANET_FUN_LTE 29 -#define JANET_FUN_EQ 30 -#define JANET_FUN_NEQ 31 -#define JANET_FUN_PROP 32 -#define JANET_FUN_GET 33 +#define JANET_FUN_GT 20 +#define JANET_FUN_LT 21 +#define JANET_FUN_GTE 22 +#define JANET_FUN_LTE 23 +#define JANET_FUN_EQ 24 +#define JANET_FUN_NEQ 25 +#define JANET_FUN_PROP 26 +#define JANET_FUN_GET 27 /* Compiler typedefs */ typedef struct JanetCompiler JanetCompiler; diff --git a/src/core/corelib.c b/src/core/corelib.c index 958503de..b34ad609 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -1090,45 +1090,23 @@ JanetTable *janet_core_env(JanetTable *replacements) { "for positive shifts the return value will always be positive.")); /* Variadic comparators */ - templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN, - JDOC("(order> & xs)\n\n" - "Check if xs is strictly descending according to a total order " - "over all values. Returns a boolean.")); - templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN, - JDOC("(order< & xs)\n\n" - "Check if xs is strictly increasing according to a total order " - "over all values. Returns a boolean.")); - templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN, - JDOC("(order>= & xs)\n\n" - "Check if xs is not increasing according to a total order " - "over all values. Returns a boolean.")); - templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN, - JDOC("(order<= & xs)\n\n" - "Check if xs is not decreasing according to a total order " - "over all values. Returns a boolean.")); - templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS, - JDOC("(= & xs)\n\n" - "Returns true if all values in xs are the same, false otherwise.")); - templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS, - JDOC("(not= & xs)\n\n" - "Return true if any values in xs are not equal, otherwise false.")); - templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN, + templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN, JDOC("(> & xs)\n\n" "Check if xs is in numerically descending order. Returns a boolean.")); - templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN, + templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN, JDOC("(< & xs)\n\n" "Check if xs is in numerically ascending order. Returns a boolean.")); - templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL, + templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL, JDOC("(>= & xs)\n\n" "Check if xs is in numerically non-ascending order. Returns a boolean.")); - templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL, + templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL, JDOC("(<= & xs)\n\n" "Check if xs is in numerically non-descending order. Returns a boolean.")); - templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL, - JDOC("(== & xs)\n\n" + templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS, + JDOC("(= & xs)\n\n" "Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean.")); - templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL, - JDOC("(not== & xs)\n\n" + templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS, + JDOC("(not= & xs)\n\n" "Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean.")); /* Platform detection */ diff --git a/src/core/inttypes.c b/src/core/inttypes.c index 38387a7f..59e3a2af 100644 --- a/src/core/inttypes.c +++ b/src/core/inttypes.c @@ -39,6 +39,24 @@ static int it_s64_get(void *p, Janet key, Janet *out); static int it_u64_get(void *p, Janet key, Janet *out); +static int32_t janet_int64_hash(void *p1, size_t size) { + (void) size; + int32_t *words = p1; + return words[0] ^ words[1]; +} + +static int janet_int64_compare(void *p1, void *p2) { + int64_t x = *((int64_t *)p1); + int64_t y = *((int64_t *)p2); + return x == y ? 0 : x < y ? -1 : 1; +} + +static int janet_uint64_compare(void *p1, void *p2) { + uint64_t x = *((uint64_t *)p1); + uint64_t y = *((uint64_t *)p2); + return x == y ? 0 : x < y ? -1 : 1; +} + static void int64_marshal(void *p, JanetMarshalContext *ctx) { janet_marshal_abstract(ctx, p); janet_marshal_int64(ctx, *((int64_t *)p)); @@ -70,7 +88,9 @@ static const JanetAbstractType it_s64_type = { NULL, int64_marshal, int64_unmarshal, - it_s64_tostring + it_s64_tostring, + janet_int64_compare, + janet_int64_hash }; static const JanetAbstractType it_u64_type = { @@ -81,7 +101,9 @@ static const JanetAbstractType it_u64_type = { NULL, int64_marshal, int64_unmarshal, - it_u64_tostring + it_u64_tostring, + janet_uint64_compare, + janet_int64_hash }; int64_t janet_unwrap_s64(Janet x) { @@ -297,7 +319,7 @@ static JanetMethod it_s64_methods[] = { {">", cfun_it_s64_gt}, {"<=", cfun_it_s64_le}, {">=", cfun_it_s64_ge}, - {"==", cfun_it_s64_eq}, + {"=", cfun_it_s64_eq}, {"!=", cfun_it_s64_ne}, {"&", cfun_it_s64_and}, {"|", cfun_it_s64_or}, @@ -329,7 +351,7 @@ static JanetMethod it_u64_methods[] = { {">", cfun_it_u64_gt}, {"<=", cfun_it_u64_le}, {">=", cfun_it_u64_ge}, - {"==", cfun_it_u64_eq}, + {"=", cfun_it_u64_eq}, {"!=", cfun_it_u64_ne}, {"&", cfun_it_u64_and}, {"|", cfun_it_u64_or}, diff --git a/src/core/io.c b/src/core/io.c index 01b86545..8d8bc007 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -49,6 +49,8 @@ JanetAbstractType cfun_io_filetype = { NULL, NULL, NULL, + NULL, + NULL, NULL }; diff --git a/src/core/math.c b/src/core/math.c index 8b936275..3db126d0 100644 --- a/src/core/math.c +++ b/src/core/math.c @@ -59,6 +59,8 @@ static JanetAbstractType JanetRNG_type = { NULL, janet_rng_marshal, janet_rng_unmarshal, + NULL, + NULL, NULL }; diff --git a/src/core/parse.c b/src/core/parse.c index ad1293b3..8e628b02 100644 --- a/src/core/parse.c +++ b/src/core/parse.c @@ -740,6 +740,8 @@ static JanetAbstractType janet_parse_parsertype = { NULL, NULL, NULL, + NULL, + NULL, NULL }; diff --git a/src/core/peg.c b/src/core/peg.c index bbb75827..318288e8 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -1203,6 +1203,8 @@ static const JanetAbstractType peg_type = { NULL, peg_marshal, peg_unmarshal, + NULL, + NULL, NULL }; diff --git a/src/core/thread.c b/src/core/thread.c index 0d1e0245..f5b0c806 100644 --- a/src/core/thread.c +++ b/src/core/thread.c @@ -393,6 +393,8 @@ static JanetAbstractType Thread_AT = { NULL, NULL, NULL, + NULL, + NULL, NULL }; diff --git a/src/core/typedarray.c b/src/core/typedarray.c index f92e6f96..c5e551ac 100644 --- a/src/core/typedarray.c +++ b/src/core/typedarray.c @@ -118,6 +118,8 @@ static const JanetAbstractType ta_buffer_type = { NULL, ta_buffer_marshal, ta_buffer_unmarshal, + NULL, + NULL, NULL }; @@ -282,6 +284,8 @@ static const JanetAbstractType ta_view_type = { ta_setter, ta_view_marshal, ta_view_unmarshal, + NULL, + NULL, NULL }; diff --git a/src/core/util.c b/src/core/util.c index 4cc034aa..baab0acf 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -295,6 +295,8 @@ static const JanetAbstractType type_wrap = { NULL, NULL, NULL, + NULL, + NULL, NULL }; diff --git a/src/core/value.c b/src/core/value.c index 7f436773..c6687fd1 100644 --- a/src/core/value.c +++ b/src/core/value.c @@ -28,6 +28,20 @@ * Define a number of functions that can be used internally on ANY Janet. */ +/* Compare two abstract values */ +static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) { + if (xx == yy) return 0; + const JanetAbstractType *xt = janet_abstract_type(xx); + const JanetAbstractType *yt = janet_abstract_type(yy); + if (xt != yt) { + return xt > yt ? 1 : -1; + } + if (xt->compare == NULL) { + return xx > yy ? 1 : -1; + } + return xt->compare(xx, yy); +} + /* Check if two values are equal. This is strict equality with no conversion. */ int janet_equals(Janet x, Janet y) { int result = 0; @@ -53,6 +67,9 @@ int janet_equals(Janet x, Janet y) { case JANET_STRUCT: result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y)); break; + case JANET_ABSTRACT: + result = !janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y)); + break; default: /* compare pointers */ result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y)); @@ -83,6 +100,15 @@ int32_t janet_hash(Janet x) { case JANET_STRUCT: hash = janet_struct_hash(janet_unwrap_struct(x)); break; + case JANET_ABSTRACT: { + JanetAbstract xx = janet_unwrap_abstract(x); + const JanetAbstractType *at = janet_abstract_type(xx); + if (at->hash != NULL) { + hash = at->hash(xx, janet_abstract_size(xx)); + break; + } + } + /* fallthrough */ default: /* TODO - test performance with different hash functions */ if (sizeof(double) == sizeof(void *)) { @@ -104,7 +130,7 @@ int32_t janet_hash(Janet x) { /* Compares x to y. If they are equal returns 0. If x is less, returns -1. * If y is less, returns 1. All types are comparable - * and should have strict ordering. */ + * and should have strict ordering, excepts NaNs. */ int janet_compare(Janet x, Janet y) { if (janet_type(x) == janet_type(y)) { switch (janet_type(x)) { @@ -112,20 +138,13 @@ int janet_compare(Janet x, Janet y) { return 0; case JANET_BOOLEAN: return janet_unwrap_boolean(x) - janet_unwrap_boolean(y); - case JANET_NUMBER: - /* Check for NaNs to ensure total order */ - if (janet_unwrap_number(x) != janet_unwrap_number(x)) - return janet_unwrap_number(y) != janet_unwrap_number(y) - ? 0 - : -1; - if (janet_unwrap_number(y) != janet_unwrap_number(y)) - return 1; - - if (janet_unwrap_number(x) == janet_unwrap_number(y)) { - return 0; - } else { - return janet_unwrap_number(x) > janet_unwrap_number(y) ? 1 : -1; - } + case JANET_NUMBER: { + double xx = janet_unwrap_number(x); + double yy = janet_unwrap_number(y); + return xx == yy + ? 0 + : (xx < yy) ? -1 : 1; + } case JANET_STRING: case JANET_SYMBOL: case JANET_KEYWORD: @@ -134,6 +153,8 @@ int janet_compare(Janet x, Janet y) { return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y)); case JANET_STRUCT: return janet_struct_compare(janet_unwrap_struct(x), janet_unwrap_struct(y)); + case JANET_ABSTRACT: + return janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y)); default: if (janet_unwrap_string(x) == janet_unwrap_string(y)) { return 0; diff --git a/src/core/vm.c b/src/core/vm.c index 4f5bd24d..ed736537 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -149,7 +149,6 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL; stack[A] = janet_mcall(#op, 2, _argv);\ vm_pcnext();\ } else {\ - vm_assert_type(op1, JANET_NUMBER);\ vm_assert_type(op2, JANET_NUMBER);\ double x1 = janet_unwrap_number(op1);\ double x2 = janet_unwrap_number(op2);\ @@ -158,7 +157,6 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL; }\ } #define vm_binop(op) _vm_binop(op, janet_wrap_number) -#define vm_numcomp(op) _vm_binop(op, janet_wrap_boolean) #define _vm_bitop(op, type1)\ {\ Janet op1 = stack[B];\ @@ -172,6 +170,21 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL; } #define vm_bitop(op) _vm_bitop(op, int32_t) #define vm_bitopu(op) _vm_bitop(op, uint32_t) +#define vm_compop(op) \ + {\ + 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 {\ + double x1 = janet_unwrap_number(op1);\ + double x2 = janet_unwrap_number(op2);\ + stack[A] = janet_wrap_boolean(x1 op x2);\ + vm_pcnext();\ + }\ + } /* Trace a function call */ static void vm_do_trace(JanetFunction *func) { @@ -288,11 +301,11 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) &&label_JOP_MAKE_TABLE, &&label_JOP_MAKE_TUPLE, &&label_JOP_MAKE_BRACKET_TUPLE, - &&label_JOP_NUMERIC_LESS_THAN, - &&label_JOP_NUMERIC_LESS_THAN_EQUAL, - &&label_JOP_NUMERIC_GREATER_THAN, - &&label_JOP_NUMERIC_GREATER_THAN_EQUAL, - &&label_JOP_NUMERIC_EQUAL, + &&label_JOP_GREATER_THAN_EQUAL, + &&label_JOP_LESS_THAN_EQUAL, + &&label_unknown_op, + &&label_unknown_op, + &&label_unknown_op, &&label_unknown_op, &&label_unknown_op, &&label_unknown_op, @@ -557,21 +570,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) VM_OP(JOP_MULTIPLY) vm_binop(*); - VM_OP(JOP_NUMERIC_LESS_THAN) - vm_numcomp( <); - - VM_OP(JOP_NUMERIC_LESS_THAN_EQUAL) - vm_numcomp( <=); - - VM_OP(JOP_NUMERIC_GREATER_THAN) - vm_numcomp( >); - - VM_OP(JOP_NUMERIC_GREATER_THAN_EQUAL) - vm_numcomp( >=); - - VM_OP(JOP_NUMERIC_EQUAL) - vm_numcomp( ==); - VM_OP(JOP_DIVIDE_IMMEDIATE) vm_binop_immediate( /); @@ -641,16 +639,20 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) vm_next(); VM_OP(JOP_LESS_THAN) - stack[A] = janet_wrap_boolean(janet_compare(stack[B], stack[C]) < 0); - vm_pcnext(); + vm_compop( <); + + VM_OP(JOP_LESS_THAN_EQUAL) + vm_compop( <=); VM_OP(JOP_LESS_THAN_IMMEDIATE) stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) < CS); vm_pcnext(); VM_OP(JOP_GREATER_THAN) - stack[A] = janet_wrap_boolean(janet_compare(stack[B], stack[C]) > 0); - vm_pcnext(); + vm_compop( >); + + VM_OP(JOP_GREATER_THAN_EQUAL) + vm_compop( >=); VM_OP(JOP_GREATER_THAN_IMMEDIATE) stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) > CS); diff --git a/src/include/janet.h b/src/include/janet.h index 271b4f2c..d4fad1b2 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -924,6 +924,8 @@ struct JanetAbstractType { void (*marshal)(void *p, JanetMarshalContext *ctx); void *(*unmarshal)(JanetMarshalContext *ctx); void (*tostring)(void *p, JanetBuffer *buffer); + int (*compare)(void *lhs, void *rhs); + int32_t (*hash)(void *p, size_t len); }; struct JanetReg { @@ -1075,11 +1077,8 @@ enum JanetOpCode { JOP_MAKE_TABLE, JOP_MAKE_TUPLE, JOP_MAKE_BRACKET_TUPLE, - JOP_NUMERIC_LESS_THAN, - JOP_NUMERIC_LESS_THAN_EQUAL, - JOP_NUMERIC_GREATER_THAN, - JOP_NUMERIC_GREATER_THAN_EQUAL, - JOP_NUMERIC_EQUAL, + JOP_GREATER_THAN_EQUAL, + JOP_LESS_THAN_EQUAL, JOP_INSTRUCTION_COUNT }; diff --git a/test/suite0.janet b/test/suite0.janet index 16b764d3..e79ec397 100644 --- a/test/suite0.janet +++ b/test/suite0.janet @@ -37,18 +37,18 @@ (assert (= 7 (% 20 13)) "modulo 1") (assert (= -7 (% -20 13)) "modulo 2") -(assert (order< 1.0 nil false true - (fiber/new (fn [] 1)) - "hi" - (quote hello) - :hello - (array 1 2 3) - (tuple 1 2 3) - (table "a" "b" "c" "d") - (struct 1 2 3 4) - (buffer "hi") - (fn [x] (+ x x)) - print) "type ordering") +(assert (< 1.0 nil false true + (fiber/new (fn [] 1)) + "hi" + (quote hello) + :hello + (array 1 2 3) + (tuple 1 2 3) + (table "a" "b" "c" "d") + (struct 1 2 3 4) + (buffer "hi") + (fn [x] (+ x x)) + print) "type ordering") (assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal") (assert (= (get {} 1) nil) "get nil from empty struct") diff --git a/test/suite1.janet b/test/suite1.janet index 7eb8c0ce..d6369107 100644 --- a/test/suite1.janet +++ b/test/suite1.janet @@ -232,11 +232,11 @@ (assert (= 4 ((get closures 4))) "closure in loop 4") # More numerical tests -(assert (== 1 1.0) "numerical equal 1") -(assert (== 0 0.0) "numerical equal 2") -(assert (== 0 -0.0) "numerical equal 3") -(assert (== 2_147_483_647 2_147_483_647.0) "numerical equal 4") -(assert (== -2_147_483_648 -2_147_483_648.0) "numerical equal 5") +(assert (= 1 1.0) "numerical equal 1") +(assert (= 0 0.0) "numerical equal 2") +(assert (= 0 -0.0) "numerical equal 3") +(assert (= 2_147_483_647 2_147_483_647.0) "numerical equal 4") +(assert (= -2_147_483_648 -2_147_483_648.0) "numerical equal 5") # Array tests diff --git a/test/suite6.janet b/test/suite6.janet index 4550413a..e1132369 100644 --- a/test/suite6.janet +++ b/test/suite6.janet @@ -62,8 +62,8 @@ # just to big (def d (u64 "123456789123456789123456789")))) -(assert (:== (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) "0xfffffffffffffff") "bigint operations") -(assert (let [a (u64 0xff)] (:== (:+ a a a a) (:* a 2 2))) "bigint operations") +(assert (= (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) (u64 "0xfffffffffffffff")) "bigint operations 1") +(assert (let [a (u64 0xff)] (= (:+ a a a a) (:* a 2 2))) "bigint operations 2") (assert (= (string (i64 -123)) "-123") "i64 prints reasonably") (assert (= (string (u64 123)) "123") "u64 prints reasonably") @@ -73,7 +73,7 @@ (:/ (int/s64 "-0x8000_0000_0000_0000") -1)) # in place operators -(assert (let [a (u64 1e10)] (:+! a 1000000 "1000000" "0xffff") (:== a 10002065535)) "in place operators") +(assert (let [a (u64 1e10)] (:+! a 1000000 "1000000" "0xffff") (:= a 10002065535)) "in place operators") # int64 typed arrays (assert (let [t (tarray/new :int64 10) @@ -84,10 +84,10 @@ (set (t 3) (t 0)) (set (t 4) (u64 1000)) (and - (:== (t 0) (t 1)) - (:== (t 1) (t 2)) - (:== (t 2) (t 3)) - (:== (t 3) (t 4)) + (= (t 0) (t 1)) + (= (t 1) (t 2)) + (= (t 2) (t 3)) + (= (t 3) (t 4)) )) "int64 typed arrays")