diff options
author | Leah Neukirchen <leah@vuxu.org> | 2023-01-02 21:35:29 +0100 |
---|---|---|
committer | Leah Neukirchen <leah@vuxu.org> | 2023-01-02 21:35:29 +0100 |
commit | 58f600a1bda649cf60568fd6c53784f035899d63 (patch) | |
tree | 16d0a79fe38f1856ccfe5600f4b8e266845f9d71 /mew.scm | |
parent | 31afd1f7be00fbd28ea1c66ad9411d4fdf722ea7 (diff) | |
download | mew-58f600a1bda649cf60568fd6c53784f035899d63.tar.gz mew-58f600a1bda649cf60568fd6c53784f035899d63.tar.xz mew-58f600a1bda649cf60568fd6c53784f035899d63.zip |
add sort-by
Diffstat (limited to 'mew.scm')
-rw-r--r-- | mew.scm | 17 |
1 files changed, 16 insertions, 1 deletions
diff --git a/mew.scm b/mew.scm index d0de5e0..70bcff6 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! sort sort! str slurp + shuffle shuffle! sort sort-by sort! str slurp tally-accumulator tbl time while uniq-accumulator unlist until @@ -1361,6 +1361,21 @@ (chicken-sort! xs less?) (error "can only sort! vectors"))))) + (define sort-by + (case-lambda + ((sequence transform) (sort-by sequence transform <?)) + ((sequence transform less?) + (let ((t (tbl))) + (define (cached k) + (hash-table-ref t k + (lambda () + (let ((v (transform k))) + (hash-table-set! t k v) + v)))) + (sort sequence (lambda (a b) + (less? (cached a) (cached b)))))))) + + (let ((old-repl-prompt (repl-prompt))) (repl-prompt (lambda () (let ((old-prompt (old-repl-prompt))) |