summaryrefslogtreecommitdiffstats
path: root/sort.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:31 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:31 -0800
commit5145dd3aa0c02c9fc496d1432fc4410674206e1d (patch)
tree540afc30c51da085f5bd8ec3f4c89f6496e7900d /sort.scm
parent8466d8cfa486fb30d1755c4261b781135083787b (diff)
downloadslib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.tar.gz
slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.zip
Import Upstream version 3a2upstream/3a2
Diffstat (limited to 'sort.scm')
-rw-r--r--sort.scm25
1 files changed, 13 insertions, 12 deletions
diff --git a/sort.scm b/sort.scm
index c46cf3c..b2199a9 100644
--- a/sort.scm
+++ b/sort.scm
@@ -19,13 +19,14 @@
(define (sorted? seq less?)
(cond ((null? seq) #t)
((array? seq)
- (let ((shape (array-shape seq)))
- (or (<= (- (cadar shape) (caar shape)) 0)
- (do ((i (+ 1 (caar shape)) (+ i 1)))
- ((or (= i (cadar shape))
+ (let ((dims (array-dimensions seq)))
+ (define dimax (+ -1 (car dims)))
+ (or (<= dimax 0)
+ (do ((i 1 (+ i 1)))
+ ((or (= i dimax)
(less? (array-ref seq i)
(array-ref seq (- i 1))))
- (= i (cadar shape)))))))
+ (= i dimax))))))
(else
(let loop ((last (car seq)) (next (cdr seq)))
(or (null? next)
@@ -117,10 +118,10 @@
(else
'())))
(cond ((array? seq)
- (let ((shape (array-shape seq))
+ (let ((dims (array-dimensions seq))
(vec seq))
(set! seq (rank-1-array->list seq))
- (do ((p (step (+ 1 (cadar shape))) (cdr p))
+ (do ((p (step (car dims)) (cdr p))
(i 0 (+ i 1)))
((null? p) vec)
(array-set! vec (car p) i))))
@@ -128,10 +129,10 @@
(step (length seq)))))
(define (rank-1-array->list array)
- (define shape (array-shape array))
- (do ((idx (cadar shape) (+ -1 idx))
+ (define dimensions (array-dimensions array))
+ (do ((idx (+ -1 (car dimensions)) (+ -1 idx))
(lst '() (cons (array-ref array idx) lst)))
- ((< idx (caar shape)) lst)))
+ ((< idx 0) lst)))
;;; (sort sequence less?)
;;; sorts a array, string, or list non-destructively. It does this
@@ -146,8 +147,8 @@
((string? seq)
(list->string (sort:sort! (string->list seq) less?)))
((array? seq)
- (let ((shape (array-shape seq)))
- (define newra (apply create-array seq shape))
+ (let ((dimensions (array-dimensions seq)))
+ (define newra (apply make-array seq dimensions))
(do ((sorted (sort:sort! (rank-1-array->list seq) less?)
(cdr sorted))
(i 0 (+ i 1)))