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

---
 arraymap.scm | 72 +++++++++++++++++++++++++++++-------------------------------
 1 file changed, 35 insertions(+), 37 deletions(-)

(limited to 'arraymap.scm')

diff --git a/arraymap.scm b/arraymap.scm
index 747962e..2c88eb8 100644
--- a/arraymap.scm
+++ b/arraymap.scm
@@ -1,5 +1,5 @@
 ;;;; "arraymap.scm", applicative routines for arrays in Scheme.
-;;; Copyright (c) 1993, 2003 Aubrey Jaffer
+;;; Copyright (C) 1993, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -30,21 +30,20 @@
 ;;as the corresponding element in @var{array0}.  The value returned is
 ;;unspecified.  The order of application is unspecified.
 (define (array-map! ra0 proc . ras)
-  (define (ramap rshape inds)
-    (if (null? (cdr rshape))
-	(do ((i (cadar rshape) (+ -1 i))
-	     (is (cons (cadar rshape) inds)
+  (define (ramap rdims inds)
+    (if (null? (cdr rdims))
+	(do ((i (+ -1 (car rdims)) (+ -1 i))
+	     (is (cons (+ -1 (car rdims)) inds)
 		 (cons (+ -1 i) inds)))
-	    ((< i (caar rshape)))
+	    ((negative? i))
 	  (apply array-set! ra0
 		 (apply proc (map (lambda (ra) (apply array-ref ra is)) ras))
 		 is))
-	(let ((crshape (cdr rshape))
-	      (ll (caar rshape)))
-	  (do ((i (cadar rshape) (+ -1 i)))
-	      ((< i ll))
-	    (ramap crshape (cons i inds))))))
-  (ramap (reverse (array-shape ra0)) '()))
+	(let ((crdims (cdr rdims)))
+	  (do ((i (+ -1 (car rdims)) (+ -1 i)))
+	      ((negative? i))
+	    (ramap crdims (cons i inds))))))
+  (ramap (reverse (array-dimensions ra0)) '()))
 
 ;;@args prototype proc array1 array2 @dots{}
 ;;@var{array2}, @dots{} must have the same number of dimensions as
@@ -55,7 +54,7 @@
 ;;new array of type @var{prototype}.  The new array is returned.  The
 ;;order of application is unspecified.
 (define (array-map prototype proc ra1 . ras)
-  (define nra (apply create-array prototype (array-shape ra1)))
+  (define nra (apply make-array prototype (array-dimensions ra1)))
   (apply array-map! nra proc ra1 ras)
   nra)
 
@@ -63,20 +62,20 @@
 ;;@var{proc} is applied to each tuple of elements of @var{array0} @dots{}
 ;;in row-major order.  The value returned is unspecified.
 (define (array-for-each proc . ras)
-  (define (rafe rshape inds)
-    (if (null? (cdr rshape))
+  (define (rafe rdims inds)
+    (if (null? (cdr rdims))
 	(let ((sdni (reverse (cons #f inds))))
 	  (define lastpair (last-pair sdni))
-	  (do ((i (caar rshape) (+ 1 i)))
-	      ((> i (cadar rshape)))
+	  (do ((i 0 (+ 1 i)))
+	      ((> i (+ -1 (car rdims))))
 	    (set-car! lastpair i)
 	    (apply proc (map (lambda (ra) (apply array-ref ra sdni)) ras))))
-	(let ((crshape (cdr rshape))
-	      (ll (cadar rshape)))
-	  (do ((i (caar rshape) (+ 1 i)))
+	(let ((crdims (cdr rdims))
+	      (ll (+ -1 (car rdims))))
+	  (do ((i 0 (+ 1 i)))
 	      ((> i ll))
-	    (rafe crshape (cons i inds))))))
-  (rafe (array-shape (car ras)) '()))
+	    (rafe crdims (cons i inds))))))
+  (rafe (array-dimensions (car ras)) '()))
 
 ;;@args array
 ;;Returns an array of lists of indexes for @var{array} such that, if
@@ -84,7 +83,7 @@
 ;;(equal?  @var{li} (apply array-ref (array-indexes @var{array})
 ;;@var{li})).
 (define (array-indexes ra)
-  (let ((ra0 (apply create-array '#() (array-shape ra))))
+  (let ((ra0 (apply make-array '#() (array-dimensions ra))))
     (array-index-map! ra0 list)
     ra0))
 
@@ -96,7 +95,7 @@
 ;;One can implement @var{array-indexes} as
 ;;@example
 ;;(define (array-indexes array)
-;;    (let ((ra (apply create-array '#() (array-shape array))))
+;;    (let ((ra (apply make-array '#() (array-dimensions array))))
 ;;      (array-index-map! ra (lambda x x))
 ;;      ra))
 ;;@end example
@@ -108,26 +107,25 @@
 ;;      v))
 ;;@end example
 (define (array-index-map! ra fun)
-  (define (ramap rshape inds)
-    (if (null? (cdr rshape))
-	(do ((i (cadar rshape) (+ -1 i))
-	     (is (cons (cadar rshape) inds)
+  (define (ramap rdims inds)
+    (if (null? (cdr rdims))
+	(do ((i (+ -1 (car rdims)) (+ -1 i))
+	     (is (cons (+ -1 (car rdims)) inds)
 		 (cons (+ -1 i) inds)))
-	    ((< i (caar rshape)))
+	    ((negative? i))
 	  (apply array-set! ra (apply fun is) is))
-	(let ((crshape (cdr rshape))
-	      (ll (caar rshape)))
-	  (do ((i (cadar rshape) (+ -1 i)))
-	      ((< i ll))
-	    (ramap crshape (cons i inds))))))
+	(let ((crdims (cdr rdims)))
+	  (do ((i (+ -1 (car rdims)) (+ -1 i)))
+	      ((negative? i))
+	    (ramap crdims (cons i inds))))))
   (if (zero? (array-rank ra))
       (array-set! ra (fun))
-      (ramap (reverse (array-shape ra)) '())))
+      (ramap (reverse (array-dimensions ra)) '())))
 
-;;@args source destination
+;;@args destination source
 ;;Copies every element from vector or array @var{source} to the
 ;;corresponding element of @var{destination}.  @var{destination} must
 ;;have the same rank as @var{source}, and be at least as large in each
 ;;dimension.  The order of copying is unspecified.
-(define (array-copy! source dest)
+(define (array:copy! dest source)
   (array-map! dest identity source))
-- 
cgit v1.2.3