From 64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:38 -0800
Subject: Import Upstream version 3a5

---
 arraymap.scm | 44 ++++++++++++++++++++++++++++++--------------
 1 file changed, 30 insertions(+), 14 deletions(-)

(limited to 'arraymap.scm')

diff --git a/arraymap.scm b/arraymap.scm
index 2c88eb8..bfac855 100644
--- a/arraymap.scm
+++ b/arraymap.scm
@@ -87,6 +87,34 @@
     (array-index-map! ra0 list)
     ra0))
 
+;;@args array proc
+;;applies @var{proc} to the indices of each element of @var{array} in
+;;turn.  The value returned and the order of application are
+;;unspecified.
+;;
+;;One can implement @var{array-index-map!} as
+;;@example
+;;(define (array-index-map! ra fun)
+;;  (array-index-for-each
+;;   ra
+;;   (lambda is (apply array-set! ra (apply fun is) is))))
+;;@end example
+(define (array-index-for-each ra fun)
+  (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)))
+	    ((negative? i))
+	  (apply fun is))
+	(let ((crdims (cdr rdims)))
+	  (do ((i (+ -1 (car rdims)) (+ -1 i)))
+	      ((negative? i))
+	    (ramap crdims (cons i inds))))))
+  (if (zero? (array-rank ra))
+      (fun)
+      (ramap (reverse (array-dimensions ra)) '())))
+
 ;;@args array proc
 ;;applies @var{proc} to the indices of each element of @var{array} in
 ;;turn, storing the result in the corresponding element.  The value
@@ -107,20 +135,8 @@
 ;;      v))
 ;;@end example
 (define (array-index-map! ra fun)
-  (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)))
-	    ((negative? i))
-	  (apply array-set! ra (apply fun is) is))
-	(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-dimensions ra)) '())))
+  (array-index-for-each ra
+			(lambda is (apply array-set! ra (apply fun is) is))))
 
 ;;@args destination source
 ;;Copies every element from vector or array @var{source} to the
-- 
cgit v1.2.3