diff options
author | Jim Pick <jim@jimpick.com> | 1998-03-08 23:05:22 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:27 -0800 |
commit | b21cac3362022718634f7086964208b2eed8e897 (patch) | |
tree | 16f4b2e70645c0e8e2202023170b5a94baa967e3 /arraymap.scm | |
parent | 3796d2595035e192ed4bf1c9a6bfdb13c3c9d261 (diff) | |
parent | f24b9140d6f74804d5599ec225717d38ca443813 (diff) | |
download | slib-b21cac3362022718634f7086964208b2eed8e897.tar.gz slib-b21cac3362022718634f7086964208b2eed8e897.zip |
Import Debian changes 2c0-3debian/2c0-3
slib (2c0-3) unstable; urgency=low
* New maintainer.
* slibconfig script to automatically configure guile.
* Fix type in description, closes: Bug#18996
slib (2c0-2) unstable; urgency=low
* Minor fix for debian/rules targets
slib (2c0-1) unstable; urgency=low
* New upstream source
* New maintainer
Diffstat (limited to 'arraymap.scm')
-rw-r--r-- | arraymap.scm | 14 |
1 files changed, 8 insertions, 6 deletions
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)) |