1
0
mirror of https://github.com/janet-lang/janet synced 2024-11-28 19:19:53 +00:00

Merge pull request #1249 from primo-ppcg/compare

Speed up `compare` functions
This commit is contained in:
Calvin Rose 2023-08-11 19:27:42 -05:00 committed by GitHub
commit 7475362c85
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -739,6 +739,14 @@
## Polymorphic comparisons ## Polymorphic comparisons
(defmacro- do-compare
[x y]
~(if (def f (get ,x :compare))
(f ,x ,y)
(if (def f (get ,y :compare))
(- (f ,y ,x))
(cmp ,x ,y))))
(defn compare (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 Differs from the primitive comparators in that it first checks to
@ -746,20 +754,18 @@
compare x and y. If so, it uses that method. If not, it compare x and y. If so, it uses that method. If not, it
delegates to the primitive comparators.`` delegates to the primitive comparators.``
[x y] [x y]
(or (do-compare x y))
(when-let [f (get x :compare)] (f x y))
(when-let [f (get y :compare)] (- (f y x)))
(cmp x y)))
(defn- compare-reduce [op xs] (defmacro- compare-reduce [op xs]
(var r true) ~(do
(loop [i :range [0 (- (length xs) 1)] (var res true)
:let [c (compare (xs i) (xs (+ i 1))) (var x (get ,xs 0))
ok (op c 0)] (forv i 1 (length ,xs)
:when (not ok)] (let [y (in ,xs i)]
(set r false) (if (,op (do-compare x y) 0)
(break)) (set x y)
r) (do (set res false) (break)))))
res))
(defn compare= (defn compare=
``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.`` ``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.``