From 5145dd3aa0c02c9fc496d1432fc4410674206e1d Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:31 -0800
Subject: Import Upstream version 3a2

---
 sort.scm | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

(limited to 'sort.scm')

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)))
-- 
cgit v1.2.3