Change compare-primitive to cmp.

cmp is implemented as a VM instruction rather than
a function.

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.

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]

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) {

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;

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"

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;
 }

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)")