summaryrefslogtreecommitdiffstats
path: root/sort.scm
diff options
context:
space:
mode:
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)))