From fb4d4d966c75723ddb5ee339db87b24078f8c900 Mon Sep 17 00:00:00 2001 From: Daniel Llorens Date: Tue, 8 Sep 2015 16:57:30 +0200 Subject: Draft of (array-for-each-cell) * libguile/arrays.c (scm_i_array_rebase, scm_array_for_each_cell): new functions. Export scm_array_for_each_cell() as (array-for-each-cell). * libguile/arrays.h (scm_i_array_rebase, scm_array_for_each_cell): prototypes. --- libguile/arrays.c | 192 +++++++++++++++++++++++++++++++++++++++++++++++++++++- libguile/arrays.h | 2 + 2 files changed, 192 insertions(+), 2 deletions(-) diff --git a/libguile/arrays.c b/libguile/arrays.c index 26c454348..de86023cd 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -546,7 +546,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); } @@ -564,11 +564,199 @@ SCM_DEFINE (scm_array_amend_x, "array-amend!", 2, 0, 1, } #undef FUNC_NAME - #undef ARRAY_FROM_POS #undef ARRAY_FROM_GET_O +// 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; +} + +SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 2, 0, 1, + (SCM frank_, SCM op, SCM a_), + "Apply op to each of the rank (-frank) cells of the arguments,\n" + "in unspecified order. The first frank dimensions of the\n" + "arguments must match. Rank-0 cells are passed as such.\n\n" + "The value returned is unspecified.\n\n" + "For example:\n" + "@lisp\n" + "@end lisp") +#define FUNC_NAME s_scm_array_for_each_cell +{ + // FIXME replace stack by scm_gc_malloc_pointerless() + int const N = scm_ilength(a_); + scm_t_array_handle ah[N]; + SCM a[N]; + scm_t_array_dim * as[N]; + int rank[N]; + for (int n=0; scm_is_pair(a_); a_=scm_cdr(a_), ++n) + { + a[n] = scm_car(a_); + scm_array_get_handle(a[n], ah+n); + as[n] = scm_array_handle_dims(ah+n); + rank[n] = scm_array_handle_rank(ah+n); + } + // checks. + int const frank = scm_to_int(frank_); + ssize_t s[frank]; + char const * msg = NULL; + if (frank<0) + { + msg = "bad frame rank"; + } else + { + for (int n=0; n!=N; ++n) { + if (rank[n]