diff options
| -rw-r--r-- | mew.scm | 18 | ||||
| -rw-r--r-- | mew.svnwiki | 14 | ||||
| -rw-r--r-- | 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)))) |