From 31afd1f7be00fbd28ea1c66ad9411d4fdf722ea7 Mon Sep 17 00:00:00 2001
From: Leah Neukirchen <leah@vuxu.org>
Date: Mon, 2 Jan 2023 21:28:52 +0100
Subject: add generic sort, sort!

---
 mew.scm        | 18 ++++++++++++++++--
 mew.svnwiki    | 14 +++++++++++++-
 tests/test.mew | 11 +++++++++++
 3 files changed, 40 insertions(+), 3 deletions(-)

diff --git a/mew.scm b/mew.scm
index 1f25c79..d0de5e0 100644
--- a/mew.scm
+++ b/mew.scm
@@ -19,7 +19,7 @@
      per pop! prn proj push! puts
      rand range rep repeat
      sample scan scan-right sing? search seq set set-at sgn
-     shuffle shuffle! str slurp
+     shuffle shuffle! sort sort! str slurp
      tally-accumulator tbl time
      while
      uniq-accumulator unlist until
@@ -46,6 +46,9 @@
           (chicken port)
           (chicken random)
           (chicken repl)
+          (rename (chicken sort)
+            (sort chicken-sort)
+            (sort! chicken-sort!))
           (chicken syntax)
           utf8-srfi-13
           srfi-17
@@ -68,7 +71,6 @@
   (reexport (chicken io))
   (reexport (chicken irregex))
   (reexport (chicken pretty-print))
-  (reexport (chicken sort))
   (reexport
     (only (r7rs)
       list->vector
@@ -1347,6 +1349,18 @@
   (define >? (cmp-op positive?))
   (define >=? (cmp-op (negate negative?)))
 
+  (define sort
+    (case-lambda
+      ((xs) (sort xs <?))
+      ((xs less?) (chicken-sort xs less?))))
+
+  (define sort!
+    (case-lambda
+      ((xs) (sort! xs <?))
+      ((xs less?) (if (vector? xs)
+                    (chicken-sort! xs less?)
+                    (error "can only sort! vectors")))))
+
   (let ((old-repl-prompt (repl-prompt)))
     (repl-prompt (lambda ()
                    (let ((old-prompt (old-repl-prompt)))
diff --git a/mew.svnwiki b/mew.svnwiki
index ffb99cb..2ac6cfe 100644
--- a/mew.svnwiki
+++ b/mew.svnwiki
@@ -43,7 +43,6 @@ SRFI-158 (Generators and Accumulators),
 {{(chicken io)}},
 {{(chicken irregex)}},
 {{(chicken pretty-print)}}},
-{{(chicken sort)}}},
 {{matchable}},
 and {{err}} (see {{err.svnwiki}}).
 
@@ -381,6 +380,19 @@ otherwise.
 It is an error to compare uncomparable values.
 
 
+== Sorting
+
+<procedure>(sort <obj> [<less?>])</procedure>
+
+Sort the list/vector {{<obj>}} according to the relation {{less?}}
+(by default: {{<?}}).
+
+<procedure>(sort! <obj> [<less?>])</procedure>
+
+Sort the vector {{<obj>}} destructively according to the relation
+{{less?}} (by default: {{<?}}).
+
+
 == Data types
 
 <procedure>(get <obj> <idx>)</procedure>
diff --git a/tests/test.mew b/tests/test.mew
index 246f9e7..ba9c223 100644
--- a/tests/test.mew
+++ b/tests/test.mew
@@ -792,3 +792,14 @@
   (test #t (>=? 2 1 1))
 
   (test-error (>=? "foo" 2 #(6 7 8))))
+
+(test-group "sort"
+  (test '(1 2 3) (sort '(3 1 2)))
+  (test #(1 2 3) (sort #(3 1 2)))
+  (test '(1 2 3) (sort '(3 1 2) <))
+  (test '(3 2 1) (sort '(3 1 2) >?)))
+
+(test-group "sort!"
+  (test #(1 2 3) (loc (v #(3 1 2)) (sort! v) v))
+  (test #(3 2 1) (loc (v #(3 1 2)) (sort! v >) v))
+  (test-error (sort! '(3 2 1))))
-- 
cgit 1.4.1