From ac5de1f96eb084ba452433e78d5be407f994c942 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 24 Jun 2020 16:00:00 -0500 Subject: [PATCH] Change compare-primitive to cmp. cmp is implemented as a VM instruction rather than a function. --- CHANGELOG.md | 2 ++ src/boot/boot.janet | 40 +++++++++++++++++++++------------------- src/core/cfuns.c | 4 ++++ src/core/compile.h | 1 + src/core/corelib.c | 9 +++++++++ src/core/string.c | 2 +- test/suite0.janet | 10 +++++----- 7 files changed, 43 insertions(+), 25 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 870dfa10..37dd8e80 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Change `compare-primitve` to `cmp` and make it more efficient. +- Change `reverse` to `reversed`, reverse now mutates the backing array - `janet_dobytes` and `janet_dostring` return parse errors in \*out - Add `repeat` macro for iterating something n times. - Add `eachy` (each yield) macro for iterating a fiber. diff --git a/src/boot/boot.janet b/src/boot/boot.janet index c20b4a9a..cb84664b 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -688,28 +688,17 @@ ## Polymorphic comparisons -(defn compare-primitive - "Compare x and y using primitive operators. - Returns -1,0,1 for x < y, x = y, x > y respectively. - Present mostly for constructing 'compare' methods in prototypes." - [x y] - (cond - (= x y) 0 - (< x y) -1 - (> x y) 1)) - (defn compare - "Polymorphic compare. Returns -1,0,1 for x < y, x = y, x > y respectively. + "Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively. Differs from the primitive comparators in that it first checks to see whether either x or y implement a 'compare' method which can - compare x and y. If so it uses that compare method. If not, it + compare x and y. If so it uses that compare method. If not, it delegates to the primitive comparators." [x y] (or (when-let [f (get x :compare)] (f x y)) - (when-let [f (get y :compare) - fyx (f y x)] (- fyx)) - (compare-primitive x y))) + (when-let [f (get y :compare)] (- (f y x))) + (cmp x y))) (defn- compare-reduce [op xs] (var r true) @@ -1209,18 +1198,31 @@ res) (defn reverse + "Reverses the order of the elements in a given array or tuple and returns a new array." + [t] + (def len-1 (- (length t) 1)) + (def half (/ len-1 2)) + (for i 0 half + (def j (- len-1 i)) + (def l (in t i)) + (def r (in t j)) + (put t i r) + (put t j l)) + t) + +(defn reversed "Reverses the order of the elements in a given array or tuple and returns a new array." [t] (def len (length t)) (var n (- len 1)) - (def reversed (array/new len)) + (def ret (array/new len)) (while (>= n 0) - (array/push reversed (in t n)) + (array/push ret (in t n)) (-- n)) - reversed) + ret) (defn invert - "Returns a table of where the keys of an associative data structure + "Returns a table where the keys of an associative data structure are the values, and the values of the keys. If multiple keys have the same value, one key will be ignored." [ds] diff --git a/src/core/cfuns.c b/src/core/cfuns.c index 40db0ff1..0520576f 100644 --- a/src/core/cfuns.c +++ b/src/core/cfuns.c @@ -148,6 +148,9 @@ static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) { static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) { return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil()); } +static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) { + return opreduce(opts, args, JOP_COMPARE, 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); @@ -323,6 +326,7 @@ static const JanetFunOptimizer optimizers[] = { {arity1or2, do_next}, {fixarity2, do_modulo}, {fixarity2, do_remainder}, + {fixarity2, do_cmp}, }; const JanetFunOptimizer *janetc_funopt(uint32_t flags) { diff --git a/src/core/compile.h b/src/core/compile.h index 3f53da58..5782bbf1 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -60,6 +60,7 @@ #define JANET_FUN_NEXT 28 #define JANET_FUN_MODULO 29 #define JANET_FUN_REMAINDER 30 +#define JANET_FUN_CMP 31 /* Compiler typedefs */ typedef struct JanetCompiler JanetCompiler; diff --git a/src/core/corelib.c b/src/core/corelib.c index 3e17e918..f2b187f8 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -968,6 +968,10 @@ static const uint32_t remainder_asm[] = { JOP_REMAINDER | (1 << 24), JOP_RETURN }; +static const uint32_t cmp_asm[] = { + JOP_COMPARE | (1 << 24), + JOP_RETURN +}; #endif /* ifdef JANET_BOOTSTRAP */ /* @@ -1021,6 +1025,11 @@ JanetTable *janet_core_env(JanetTable *replacements) { "%", 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_CMP, + "cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm), + JDOC("(cmp x y)\n\n" + "Returns -1 if x is strictly less than y, 1 if y is strictly greater " + "than x, and 0 otherwise. To return 0, x and y must be the exact same type.")); janet_quick_asm(env, JANET_FUN_NEXT, "next", 2, 1, 2, 2, next_asm, sizeof(next_asm), JDOC("(next ds &opt key)\n\n" diff --git a/src/core/string.c b/src/core/string.c index b397a0f1..7c4ed80c 100644 --- a/src/core/string.c +++ b/src/core/string.c @@ -62,7 +62,7 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) { int32_t ylen = janet_string_length(rhs); int32_t len = xlen > ylen ? ylen : xlen; int res = memcmp(lhs, rhs, len); - if (res) return res; + if (res) return res > 0 ? 1 : -1; if (xlen == ylen) return 0; return xlen < ylen ? -1 : 1; } diff --git a/test/suite0.janet b/test/suite0.janet index f5fa2a8b..fa8352cf 100644 --- a/test/suite0.janet +++ b/test/suite0.janet @@ -337,9 +337,9 @@ ## Polymorphic comparison -- Issue #272 # confirm polymorphic comparison delegation to primitive comparators: -(assert (= 0 (compare-primitive 3 3)) "compare-primitive integers (1)") -(assert (= -1 (compare-primitive 3 5)) "compare-primitive integers (2)") -(assert (= 1 (compare-primitive "foo" "bar")) "compare-primitive strings") +(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)") +(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)") +(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings") (assert (= 0 (compare 1 1)) "compare integers (1)") (assert (= -1 (compare 1 2)) "compare integers (2)") (assert (= 1 (compare "foo" "bar")) "compare strings (1)") @@ -372,9 +372,9 @@ @{:type :mynum :v 0 :compare (fn [self other] (case (type other) - :number (compare-primitive (self :v) other) + :number (cmp (self :v) other) :table (when (= (get other :type) :mynum) - (compare-primitive (self :v) (other :v)))))}) + (cmp (self :v) (other :v)))))}) (let [n3 (table/setproto @{:v 3} mynum)] (assert (= 0 (compare 3 n3)) "compare num to object (1)")