Import Upstream version 3a1upstream/3a1

1 files changed, 69 insertions, 14 deletions

diff --git a/arraymap.scm b/arraymap.scm
index 15e24da..747962e 100644
--- a/arraymap.scm
+++ b/arraymap.scm
@@ -1,5 +1,5 @@
 ;;;; "arraymap.scm", applicative routines for arrays in Scheme.
-;;; Copyright (c) 1993 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
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -19,6 +19,16 @@
 
 (require 'array)
 
+;;@code{(require 'array-for-each)}
+;;@ftindex array-for-each
+
+;;@args array0 proc array1 @dots{}
+;;@var{array1}, @dots{} must have the same number of dimensions as
+;;@var{array0} and have a range for each index which includes the range
+;;for the corresponding index in @var{array0}.  @var{proc} is applied to
+;;each tuple of elements of @var{array1} @dots{} and the result is stored
+;;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))
@@ -27,8 +37,7 @@
 		 (cons (+ -1 i) inds)))
 	    ((< i (caar rshape)))
 	  (apply array-set! ra0
-		 (apply proc (map (lambda (ra) (apply array-ref ra is))
-				  ras))
+		 (apply proc (map (lambda (ra) (apply array-ref ra is)) ras))
 		 is))
 	(let ((crshape (cdr rshape))
 	      (ll (caar rshape)))
@@ -37,14 +46,31 @@
 	    (ramap crshape (cons i inds))))))
   (ramap (reverse (array-shape ra0)) '()))
 
+;;@args prototype proc array1 array2 @dots{}
+;;@var{array2}, @dots{} must have the same number of dimensions as
+;;@var{array1} and have a range for each index which includes the
+;;range for the corresponding index in @var{array1}.  @var{proc} is
+;;applied to each tuple of elements of @var{array1}, @var{array2},
+;;@dots{} and the result is stored as the corresponding element in a
+;;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)))
+  (apply array-map! nra proc ra1 ras)
+  nra)
+
+;;@args proc array0 @dots{}
+;;@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))
-	(do ((i (caar rshape) (+ 1 i)))
-	    ((> i (cadar rshape)))
-	  (apply proc
-		 (map (lambda (ra)
-			(apply array-ref ra (reverse (cons i inds)))) ras)))
+	(let ((sdni (reverse (cons #f inds))))
+	  (define lastpair (last-pair sdni))
+	  (do ((i (caar rshape) (+ 1 i)))
+	      ((> i (cadar rshape)))
+	    (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)))
@@ -52,6 +78,35 @@
 	    (rafe crshape (cons i inds))))))
   (rafe (array-shape (car ras)) '()))
 
+;;@args array
+;;Returns an array of lists of indexes for @var{array} such that, if
+;;@var{li} is a list of indexes for which @var{array} is defined,
+;;(equal?  @var{li} (apply array-ref (array-indexes @var{array})
+;;@var{li})).
+(define (array-indexes ra)
+  (let ((ra0 (apply create-array '#() (array-shape ra))))
+    (array-index-map! ra0 list)
+    ra0))
+
+;;@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
+;;returned and the order of application are unspecified.
+;;
+;;One can implement @var{array-indexes} as
+;;@example
+;;(define (array-indexes array)
+;;    (let ((ra (apply create-array '#() (array-shape array))))
+;;      (array-index-map! ra (lambda x x))
+;;      ra))
+;;@end example
+;;Another example:
+;;@example
+;;(define (apl:index-generator n)
+;;    (let ((v (make-vector n 1)))
+;;      (array-index-map! v (lambda (i) i))
+;;      v))
+;;@end example
 (define (array-index-map! ra fun)
   (define (ramap rshape inds)
     (if (null? (cdr rshape))
@@ -69,10 +124,10 @@
       (array-set! ra (fun))
       (ramap (reverse (array-shape ra)) '())))
 
-(define (array-indexes ra)
-  (let ((ra0 (apply make-array '() (array-shape ra))))
-    (array-index-map! ra0 list)
-    ra0))
-
+;;@args source destination
+;;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)
   (array-map! dest identity source))