diff options
-rw-r--r-- | doc/ref/api-compound.texi | 169 | ||||
-rw-r--r-- | libguile/array-map.c | 260 | ||||
-rw-r--r-- | libguile/array-map.h | 4 | ||||
-rw-r--r-- | libguile/arrays.c | 5 | ||||
-rw-r--r-- | test-suite/Makefile.am | 2 | ||||
-rw-r--r-- | test-suite/tests/array-map.test (renamed from test-suite/tests/ramap.test) | 35 |
6 files changed, 416 insertions, 59 deletions
diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi index 6d1e118b6..936b4956c 100644 --- a/doc/ref/api-compound.texi +++ b/doc/ref/api-compound.texi @@ -1203,6 +1203,7 @@ dimensional arrays. * Array Syntax:: * Array Procedures:: * Shared Arrays:: +* Arrays as arrays of arrays:: * Accessing Arrays from C:: @end menu @@ -1682,24 +1683,91 @@ sample points are enough because @var{mapfunc} is linear. Return the element at @code{(idx @dots{})} in @var{array}. @end deffn + +@deffn {Scheme Procedure} shared-array-increments array +@deffnx {C Function} scm_shared_array_increments (array) +For each dimension, return the distance between elements in the root vector. +@end deffn + +@deffn {Scheme Procedure} shared-array-offset array +@deffnx {C Function} scm_shared_array_offset (array) +Return the root vector index of the first element in the array. +@end deffn + +@deffn {Scheme Procedure} shared-array-root array +@deffnx {C Function} scm_shared_array_root (array) +Return the root vector of a shared array. +@end deffn + +@deffn {Scheme Procedure} array-contents array [strict] +@deffnx {C Function} scm_array_contents (array, strict) +If @var{array} may be @dfn{unrolled} into a one dimensional shared array +without changing their order (last subscript changing fastest), then +@code{array-contents} returns that shared array, otherwise it returns +@code{#f}. All arrays made by @code{make-array} and +@code{make-typed-array} may be unrolled, some arrays made by +@code{make-shared-array} may not be. + +If the optional argument @var{strict} is provided, a shared array will +be returned only if its elements are stored internally contiguous in +memory. +@end deffn + +@deffn {Scheme Procedure} transpose-array array dim1 dim2 @dots{} +@deffnx {C Function} scm_transpose_array (array, dimlist) +Return an array sharing contents with @var{array}, but with +dimensions arranged in a different order. There must be one +@var{dim} argument for each dimension of @var{array}. +@var{dim1}, @var{dim2}, @dots{} should be integers between 0 +and the rank of the array to be returned. Each integer in that +range must appear at least once in the argument list. + +The values of @var{dim1}, @var{dim2}, @dots{} correspond to +dimensions in the array to be returned, and their positions in the +argument list to dimensions of @var{array}. Several @var{dim}s +may have the same value, in which case the returned array will +have smaller rank than @var{array}. + +@lisp +(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d)) +(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d) +(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) @result{} + #2((a 4) (b 5) (c 6)) +@end lisp +@end deffn + +@node Arrays as arrays of arrays +@subsubsection Arrays as arrays of arrays + +The functions in this section allow you to treat an array of rank +@math{n} as an array of lower rank @math{n-k} where the elements are +themselves arrays (`cells') of rank @math{k}. This replicates some of +the functionality of `enclosed arrays', a feature of old Guile that was +removed before @w{version 2.0}. However, these functions do not require +a special type and operate on any array. + +When we operate on an array in this way, we speak of the first @math{k} +dimensions of the array as the @math{k}-`frame' of the array, while the +last @math{n-k} dimensions are the dimensions of the +@math{n-k}-`cell'. For example, a 2D-array (a matrix) can be seen as a +1D array of rows. In this case, the rows are the 1-cells of the array. + @deffn {Scheme Procedure} array-from array idx @dots{} @deffnx {C Function} scm_array_from (array, idxlist) If the length of @var{idxlist} equals the rank @math{n} of @var{array}, return the element at @code{(idx @dots{})}, just like @code{(array-ref array idx @dots{})}. If, however, the length @math{k} of @var{idxlist} is shorter than @math{n}, then return the shared -@math{(n-k)}-rank prefix cell of @var{array} given by @var{idxlist}. +@math{(n-k)}-rank cell of @var{array} given by @var{idxlist}. For example: -@example @lisp (array-from #2((a b) (c d)) 0) @result{} #(a b) (array-from #2((a b) (c d)) 1) @result{} #(c d) (array-from #2((a b) (c d)) 1 1) @result{} d (array-from #2((a b) (c d))) @result{} #2((a b) (c d)) @end lisp -@end example @code{(apply array-from array indices)} is equivalent to @@ -1719,12 +1787,11 @@ The name `from' comes from the J language. @deffnx {C Function} scm_array_from_s (array, idxlist) Like @code{(array-from array idx @dots{})}, but return a 0-rank shared array if the length of @var{idxlist} matches the rank of -@var{array}. This can be useful when using @var{ARRAY} as destination -of copies. +@var{array}. This can be useful when using @var{ARRAY} as a place to +write into. Compare: -@example @lisp (array-from #2((a b) (c d)) 1 1) @result{} d (array-from* #2((a b) (c d)) 1) @result{} #0(d) @@ -1733,7 +1800,6 @@ Compare: a @result{} #2((a a) (a b)). (array-fill! (array-from a 1 1) 'b) @result{} error: not an array @end lisp -@end example @code{(apply array-from* array indices)} is equivalent to @@ -1752,7 +1818,7 @@ If the length of @var{idxlist} equals the rank @math{n} of @var{x}, just like @code{(array-set! array x idx @dots{})}. If, however, the length @math{k} of @var{idxlist} is shorter than @math{n}, then copy the @math{(n-k)}-rank array @var{x} -into @math{(n-k)}-rank prefix cell of @var{array} given by +into the @math{(n-k)}-cell of @var{array} given by @var{idxlist}. In this case, the last @math{(n-k)} dimensions of @var{array} and the dimensions of @var{x} must match exactly. @@ -1760,12 +1826,19 @@ This function returns the modified @var{array}. For example: -@example @lisp (array-amend! (make-array 'a 2 2) b 1 1) @result{} #2((a a) (a b)) (array-amend! (make-array 'a 2 2) #(x y) 1) @result{} #2((a a) (x y)) @end lisp -@end example + +Note that @code{array-amend!} will expect elements, not arrays, when the +destination has rank 0. One can work around this using +@code{array-from*} instead. + +@lisp +(array-amend! (make-array 'a 2 2) #0(b) 1 1) @result{} #2((a a) (a #0(b))) +(let ((a (make-array 'a 2 2))) (array-copy! #0(b) (array-from* a 1 1)) a) @result{} #2((a a) (a b)) +@end lisp @code{(apply array-amend! array x indices)} is equivalent to @@ -1781,58 +1854,52 @@ The name `amend' comes from the J language. @end deffn -@deffn {Scheme Procedure} shared-array-increments array -@deffnx {C Function} scm_shared_array_increments (array) -For each dimension, return the distance between elements in the root vector. -@end deffn +@deffn {Scheme Procedure} array-for-each-cell frame-rank op x @dots{} +@deffnx {C Function} scm_array_for_each_cell (array, frame_rank, op, xlist) +Each @var{x} must be an array of rank ≥ @var{frame-rank}, and +the first @var{frame-rank} dimensions of each @var{x} must all be the +same. @var{array-for-each-cell} calls @var{op} with each set of +(rank(@var{x}) - @var{frame-rank})-cells from @var{x}, in unspecified order. -@deffn {Scheme Procedure} shared-array-offset array -@deffnx {C Function} scm_shared_array_offset (array) -Return the root vector index of the first element in the array. -@end deffn +@var{array-for-each-cell} allows you to loop over cells of any rank +without having to carry an index list or construct slices manually. The +cells passed to @var{op} are shared arrays of @var{X} so it is possible +to write to them. -@deffn {Scheme Procedure} shared-array-root array -@deffnx {C Function} scm_shared_array_root (array) -Return the root vector of a shared array. -@end deffn +This function returns an unspecified value. -@deffn {Scheme Procedure} array-contents array [strict] -@deffnx {C Function} scm_array_contents (array, strict) -If @var{array} may be @dfn{unrolled} into a one dimensional shared array -without changing their order (last subscript changing fastest), then -@code{array-contents} returns that shared array, otherwise it returns -@code{#f}. All arrays made by @code{make-array} and -@code{make-typed-array} may be unrolled, some arrays made by -@code{make-shared-array} may not be. +For example, to sort the rows of rank-2 array @code{a}: -If the optional argument @var{strict} is provided, a shared array will -be returned only if its elements are stored internally contiguous in -memory. -@end deffn +@lisp +(array-for-each-cell 1 (lambda (x) (sort! x <)) a) +@end lisp -@deffn {Scheme Procedure} transpose-array array dim1 dim2 @dots{} -@deffnx {C Function} scm_transpose_array (array, dimlist) -Return an array sharing contents with @var{array}, but with -dimensions arranged in a different order. There must be one -@var{dim} argument for each dimension of @var{array}. -@var{dim1}, @var{dim2}, @dots{} should be integers between 0 -and the rank of the array to be returned. Each integer in that -range must appear at least once in the argument list. +As another example, let @code{a} be a rank-2 array where each row is a 2-vector @math{(x,y)}. +Let's compute the arguments of these vectors and store them in rank-1 array @code{b}. +@lisp +(array-for-each-cell 1 + (lambda (a b) + (array-set! b (atan (array-ref a 1) (array-ref a 0)))) + a b) +@end lisp -The values of @var{dim1}, @var{dim2}, @dots{} correspond to -dimensions in the array to be returned, and their positions in the -argument list to dimensions of @var{array}. Several @var{dim}s -may have the same value, in which case the returned array will -have smaller rank than @var{array}. +@code{(apply array-for-each-cell frame-rank op x)} is functionally +equivalent to @lisp -(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d)) -(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d) -(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) @result{} - #2((a 4) (b 5) (c 6)) +(let ((frame (take (array-dimensions (car x)) frank))) + (unless (every (lambda (x) + (equal? frame (take (array-dimensions x) frank))) + (cdr x)) + (error)) + (array-index-map! + (apply make-shared-array (make-array #t) (const '()) frame) + (lambda i (apply op (map (lambda (x) (apply array-from* x i)) x))))) @end lisp + @end deffn + @node Accessing Arrays from C @subsubsection Accessing Arrays from C diff --git a/libguile/array-map.c b/libguile/array-map.c index 01bebb83e..f907786fd 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -42,7 +42,7 @@ #include "libguile/validate.h" #include "libguile/array-map.h" - +#include <assert.h> /* The WHAT argument for `scm_gc_malloc ()' et al. */ static const char vi_gc_hint[] = "array-indices"; @@ -629,7 +629,8 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1, return SCM_BOOL_T; while (!scm_is_null (rest)) - { if (scm_is_false (scm_array_equal_p (ra0, ra1))) + { + if (scm_is_false (scm_array_equal_p (ra0, ra1))) return SCM_BOOL_F; ra0 = ra1; ra1 = scm_car (rest); @@ -640,6 +641,261 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1, #undef FUNC_NAME +/* Copy array descriptor with different base. */ +SCM +scm_i_array_rebase (SCM a, size_t base) +{ + size_t ndim = SCM_I_ARRAY_NDIM (a); + SCM b = scm_words (((scm_t_bits) ndim << 17) + scm_tc7_array, 3 + ndim*3); + SCM_I_ARRAY_SET_V (b, SCM_I_ARRAY_V (a)); +/* FIXME do check base */ + SCM_I_ARRAY_SET_BASE (b, base); + memcpy (SCM_I_ARRAY_DIMS (b), SCM_I_ARRAY_DIMS (a), sizeof (scm_t_array_dim)*ndim); + return b; +} + +static inline size_t padtoptr(size_t d) { return (d + (sizeof (void *) - 1)) & ~(sizeof (void *) - 1); } + +SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 2, 0, 1, + (SCM frame_rank, SCM op, SCM args), + "Apply @var{op} to each of the cells of rank rank(@var{arg})-@var{frame_rank}\n" + "of the arrays @var{args}, in unspecified order. The first\n" + "@var{frame_rank} dimensions of each @var{arg} must match.\n" + "Rank-0 cells are passed as rank-0 arrays.\n\n" + "The value returned is unspecified.\n\n" + "For example:\n" + "@lisp\n" + ";; Sort the rows of rank-2 array A.\n\n" + "(array-for-each-cell 1 (lambda (x) (sort! x <)) a)\n" + "\n" + ";; Compute the arguments of the (x y) vectors in the rows of rank-2\n" + ";; array XYS and store them in rank-1 array ANGLES. Inside OP,\n" + ";; XY is a rank-1 (2-1) array, and ANGLE is a rank-0 (1-1) array.\n\n" + "(array-for-each-cell 1 \n" + " (lambda (xy angle)\n" + " (array-set! angle (atan (array-ref xy 1) (array-ref xy 0))))\n" + " xys angles)\n" + "@end lisp") +#define FUNC_NAME s_scm_array_for_each_cell +{ + int const N = scm_ilength (args); + int const frank = scm_to_int (frame_rank); + int ocd; + ssize_t step; + SCM dargs_ = SCM_EOL; + char const * msg; + scm_t_array_dim * ais; + int n, k; + ssize_t z; + + /* to be allocated inside the pool */ + scm_t_array_handle * ah; + SCM * args_; + scm_t_array_dim ** as; + int * rank; + + ssize_t * s; + SCM * ai; + SCM ** dargs; + ssize_t * i; + + int * order; + size_t * base; + + /* size the pool */ + char * pool; + char * pool0; + size_t pool_size = 0; + pool_size += padtoptr(N*sizeof (scm_t_array_handle)); + pool_size += padtoptr(N*sizeof (SCM)); + pool_size += padtoptr(N*sizeof (scm_t_array_dim *)); + pool_size += padtoptr(N*sizeof (int)); + + pool_size += padtoptr(frank*sizeof (ssize_t)); + pool_size += padtoptr(N*sizeof (SCM)); + pool_size += padtoptr(N*sizeof (SCM *)); + pool_size += padtoptr(frank*sizeof (ssize_t)); + + pool_size += padtoptr(frank*sizeof (int)); + pool_size += padtoptr(N*sizeof (size_t)); + pool = scm_gc_malloc (pool_size, "pool"); + + /* place the items in the pool */ +#define AFIC_ALLOC_ADVANCE(pool, count, type, name) \ + name = (void *)pool; \ + pool += padtoptr(count*sizeof (type)); + + pool0 = pool; + AFIC_ALLOC_ADVANCE (pool, N, scm_t_array_handle, ah); + AFIC_ALLOC_ADVANCE (pool, N, SCM, args_); + AFIC_ALLOC_ADVANCE (pool, N, scm_t_array_dim *, as); + AFIC_ALLOC_ADVANCE (pool, N, int, rank); + + AFIC_ALLOC_ADVANCE (pool, frank, ssize_t, s); + AFIC_ALLOC_ADVANCE (pool, N, SCM, ai); + AFIC_ALLOC_ADVANCE (pool, N, SCM *, dargs); + AFIC_ALLOC_ADVANCE (pool, frank, ssize_t, i); + + AFIC_ALLOC_ADVANCE (pool, frank, int, order); + AFIC_ALLOC_ADVANCE (pool, N, size_t, base); + assert((pool0+pool_size==pool) && "internal error"); +#undef AFIC_ALLOC_ADVANCE + + for (n=0; scm_is_pair(args); args=scm_cdr(args), ++n) + { + args_[n] = scm_car(args); + scm_array_get_handle(args_[n], ah+n); + as[n] = scm_array_handle_dims(ah+n); + rank[n] = scm_array_handle_rank(ah+n); + } + /* checks */ + msg = NULL; + if (frank<0) + msg = "bad frame rank"; + else + { + for (n=0; n!=N; ++n) + { + if (rank[n]<frank) + { + msg = "frame too large for arguments"; + goto check_msg; + } + for (k=0; k!=frank; ++k) + { + if (as[n][k].lbnd!=0) + { + msg = "non-zero base index is not supported"; + goto check_msg; + } + if (as[0][k].ubnd!=as[n][k].ubnd) + { + msg = "mismatched frames"; + goto check_msg; + } + s[k] = as[n][k].ubnd + 1; + + /* this check is needed if the array cannot be entirely */ + /* unrolled, because the unrolled subloop will be run before */ + /* checking the dimensions of the frame. */ + if (s[k]==0) + goto end; + } + } + } + check_msg: ; + if (msg!=NULL) + { + for (n=0; n!=N; ++n) + scm_array_handle_release(ah+n); + scm_misc_error("array-for-each-cell", msg, scm_cons_star(frame_rank, args)); + } + /* prepare moving cells. */ + for (n=0; n!=N; ++n) + { + ai[n] = scm_i_make_array(rank[n]-frank); + SCM_I_ARRAY_SET_V (ai[n], scm_shared_array_root(args_[n])); + /* FIXME scm_array_handle_base (ah+n) should be in Guile */ + SCM_I_ARRAY_SET_BASE (ai[n], ah[n].base); + ais = SCM_I_ARRAY_DIMS(ai[n]); + for (k=frank; k!=rank[n]; ++k) + { + ais[k-frank] = as[n][k]; + } + } + /* prepare rest list for callee. */ + { + SCM *p = &dargs_; + for (n=0; n<N; ++n) + { + *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL); + dargs[n] = SCM_CARLOC (*p); + p = SCM_CDRLOC (*p); + } + } + /* special case for rank 0. */ + if (frank==0) + { + for (n=0; n<N; ++n) + *dargs[n] = ai[n]; + scm_apply_0(op, dargs_); + for (n=0; n<N; ++n) + scm_array_handle_release(ah+n); + return SCM_UNSPECIFIED; + } + /* FIXME determine best looping order. */ + for (k=0; k!=frank; ++k) + { + i[k] = 0; + order[k] = frank-1-k; + } + /* find outermost compact dim. */ + step = s[order[0]]; + ocd = 1; + for (; ocd<frank; step *= s[order[ocd]], ++ocd) + for (n=0; n!=N; ++n) + if (step*as[n][order[0]].inc!=as[n][order[ocd]].inc) + goto ocd_reached; + ocd_reached: ; + /* rank loop. */ + for (n=0; n!=N; ++n) + base[n] = SCM_I_ARRAY_BASE(ai[n]); + for (;;) + { + /* unrolled loop. */ + for (z=0; z!=step; ++z) + { + /* we are forced to create fresh array descriptors for each */ + /* call since we don't know whether the callee will keep them, */ + /* and Guile offers no way to copy the descriptor (since */ + /* descriptors are immutable). Yet another reason why this */ + /* should be in Scheme. */ + for (n=0; n<N; ++n) + { + *dargs[n] = scm_i_array_rebase(ai[n], base[n]); + base[n] += as[n][order[0]].inc; + } + scm_apply_0(op, dargs_); + } + for (n=0; n<N; ++n) + base[n] -= step*as[n][order[0]].inc; + for (k=ocd; ; ++k) + { + if (k==frank) + goto end; + else if (i[order[k]]<s[order[k]]-1) + { + ++i[order[k]]; + for (n=0; n<N; ++n) + base[n] += as[n][order[k]].inc; + break; + } + else + { + i[order[k]] = 0; + for (n=0; n<N; ++n) + base[n] += as[n][order[k]].inc*(1-s[order[k]]); + } + } + } + end:; + for (n=0; n<N; ++n) + scm_array_handle_release(ah+n); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_array_for_each_cell_in_order, "array-for-each-cell-in-order", 2, 0, 1, + (SCM frank, SCM op, SCM a), + "Same as array-for-each-cell, but visit the cells sequentially\n" + "and in row-major order.\n") +#define FUNC_NAME s_scm_array_for_each_cell_in_order +{ + return scm_array_for_each_cell (frank, op, a); +} +#undef FUNC_NAME + + void scm_init_array_map (void) { diff --git a/libguile/array-map.h b/libguile/array-map.h index cb18a628a..acfdd5e24 100644 --- a/libguile/array-map.h +++ b/libguile/array-map.h @@ -37,6 +37,10 @@ SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra); SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra); SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc); SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1); +SCM_API SCM scm_array_for_each_cell (SCM frank, SCM op, SCM args); +SCM_API SCM scm_array_for_each_cell_in_order (SCM frank, SCM op, SCM args); + +SCM_INTERNAL SCM scm_i_array_rebase (SCM a, size_t base); SCM_INTERNAL void scm_init_array_map (void); #endif /* SCM_ARRAY_MAP_H */ diff --git a/libguile/arrays.c b/libguile/arrays.c index 273c48b73..7622ea8ca 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -28,7 +28,6 @@ #include <stdio.h> #include <errno.h> #include <string.h> -#include <assert.h> #include "verify.h" @@ -551,7 +550,7 @@ SCM_DEFINE (scm_array_amend_x, "array-amend!", 2, 0, 1, { ARRAY_FROM_GET_O } scm_array_handle_release(&handle); /* an error is still possible here if o and b don't match. */ - /* TODO copying like this wastes the handle, and the bounds matching + /* FIXME copying like this wastes the handle, and the bounds matching behavior of array-copy! is not strict. */ scm_array_copy_x(b, o); } @@ -569,7 +568,6 @@ SCM_DEFINE (scm_array_amend_x, "array-amend!", 2, 0, 1, } #undef FUNC_NAME - #undef ARRAY_FROM_POS #undef ARRAY_FROM_GET_O @@ -948,6 +946,7 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate) return scm_i_print_array_dimension (&h, 0, 0, port, pstate); } + void scm_init_arrays () { diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index f940d78c7..98cc5f026 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -115,7 +115,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/r6rs-records-syntactic.test \ tests/r6rs-unicode.test \ tests/rnrs-libraries.test \ - tests/ramap.test \ + tests/array-map.test \ tests/random.test \ tests/rdelim.test \ tests/reader.test \ diff --git a/test-suite/tests/ramap.test b/test-suite/tests/array-map.test index bd8a434bd..3095b78f4 100644 --- a/test-suite/tests/ramap.test +++ b/test-suite/tests/array-map.test @@ -1,4 +1,4 @@ -;;;; ramap.test --- test array mapping functions -*- scheme -*- +;;;; array-map.test --- test array mapping functions -*- scheme -*- ;;;; ;;;; Copyright (C) 2004, 2005, 2006, 2009, 2013 Free Software Foundation, Inc. ;;;; @@ -16,7 +16,7 @@ ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -(define-module (test-suite test-ramap) +(define-module (test-suite test-array-map) #:use-module (test-suite lib)) (define exception:shape-mismatch @@ -507,3 +507,34 @@ (b (make-typed-array 'f64 0 0 2)) (c (make-typed-array 'f64 0 2 0))) (array-for-each (lambda (b c) (set! a (cons* b c a))) b c))))) + +;;; +;;; array-for-each-cell +;;; + +(with-test-prefix "array-for-each-cell" + + (pass-if-equal "1 argument frame rank 1" + #2((1 3 9) (2 7 8)) + (let* ((a (list->array 2 '((9 1 3) (7 8 2))))) + (array-for-each-cell 1 (lambda (a) (sort! a <)) a) + a)) + + (pass-if-equal "2 arguments frame rank 1" + #f64(8 -1) + (let* ((x (list->typed-array 'f64 2 '((9 1) (7 8)))) + (y (f64vector 99 99))) + (array-for-each-cell 1 (lambda (y x) (array-set! y (- (array-ref x 0) (array-ref x 1)))) y x) + y)) + + (pass-if-equal "regression: zero-sized frame loop without unrolling" + 99 + (let* ((x 99) + (o (make-array 0. 0 3 2))) + (array-for-each-cell 2 + (lambda (o a0 a1) + (set! x 0)) + o + (make-shared-array (make-array 1. 0 1) (const '(0 0)) 0 3) + (make-array 2. 0 3)) + x))) |