1
0
mirror of https://github.com/janet-lang/janet synced 2024-11-24 17:27:18 +00:00

Merge pull request #1255 from primo-ppcg/sort

Special case common `sort` usages
This commit is contained in:
Calvin Rose 2023-08-16 20:34:17 -05:00 committed by GitHub
commit 43a6a70e1e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -805,21 +805,31 @@
### ###
### ###
(defn- median-of-three [a b c] (defmacro- median-of-three
(if (not= (> a b) (> a c)) [x y z]
a ~(if (<= ,x ,y)
(if (not= (> b a) (> b c)) b c))) (if (<= ,y ,z) ,y (if (<= ,z ,x) ,x ,z))
(if (<= ,z ,y) ,y (if (<= ,x ,z) ,x ,z))))
(defmacro- sort-partition-template
[ind before? left right pivot]
~(do
(while (,before? (in ,ind ,left) ,pivot) (++ ,left))
(while (,before? ,pivot (in ,ind ,right)) (-- ,right))))
(defn- sort-help [a lo hi before?] (defn- sort-help [a lo hi before?]
(when (< lo hi) (when (< lo hi)
(def pivot (def [x y z] [(in a lo)
(median-of-three (in a hi) (in a lo) (in a (div (+ lo hi) 2))
(in a (math/floor (/ (+ lo hi) 2))))) (in a hi)])
(def pivot (median-of-three x y z))
(var left lo) (var left lo)
(var right hi) (var right hi)
(while true (while true
(while (before? (in a left) pivot) (++ left)) (case before?
(while (before? pivot (in a right)) (-- right)) < (sort-partition-template a < left right pivot)
> (sort-partition-template a > left right pivot)
(sort-partition-template a before? left right pivot))
(when (<= left right) (when (<= left right)
(def tmp (in a left)) (def tmp (in a left))
(set (a left) (in a right)) (set (a left) (in a right))
@ -827,8 +837,10 @@
(++ left) (++ left)
(-- right)) (-- right))
(if (>= left right) (break))) (if (>= left right) (break)))
(sort-help a lo right before?) (if (< lo right)
(sort-help a left hi before?)) (sort-help a lo right before?))
(if (< left hi)
(sort-help a left hi before?)))
a) a)
(defn sort (defn sort
@ -836,7 +848,8 @@
If a `before?` comparator function is provided, sorts elements using that, If a `before?` comparator function is provided, sorts elements using that,
otherwise uses `<`.`` otherwise uses `<`.``
[ind &opt before?] [ind &opt before?]
(sort-help ind 0 (- (length ind) 1) (or before? <))) (default before? <)
(sort-help ind 0 (- (length ind) 1) before?))
(defn sort-by (defn sort-by
``Sorts `ind` in-place by calling a function `f` on each element and ``Sorts `ind` in-place by calling a function `f` on each element and