From f24b9140d6f74804d5599ec225717d38ca443813 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:26 -0800
Subject: Import Upstream version 2c0

---
 arraymap.scm | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

(limited to 'arraymap.scm')

diff --git a/arraymap.scm b/arraymap.scm
index 18ee64a..d3dedba 100644
--- a/arraymap.scm
+++ b/arraymap.scm
@@ -52,25 +52,27 @@
 	    (rafe crshape (cons i inds))))))
   (rafe (array-shape (car ras)) '()))
 
-(define (shape->indexes shape)
-  (define ra0 (apply make-array '() shape))
+(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)
 		 (cons (+ -1 i) inds)))
 	    ((< i (caar rshape)))
-	  (apply array-set! ra0 is is))
+	  (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))))))
-  (ramap (reverse shape) '())
-  ra0)
+  (if (zero? (array-rank ra))
+      (array-set! ra (fun))
+      (ramap (reverse (array-shape ra)) '())))
 
 (define (array-indexes ra)
-  (shape->indexes (array-shape ra)))
+  (let ((ra0 (apply make-array '() (array-shape ra))))
+    (array-index-map! ra0 list)
+    ra0))
 
 (define (array-copy! source dest)
   (array-map! dest identity source))
-- 
cgit v1.2.3