lloda pushed a commit to branch lloda-squash0 in repository guile. commit d8ff1beb59884277a49f6ef97fb89d48761e02a3 Author: Daniel Llorens <daniel.llor...@bluewin.ch> Date: Mon Feb 9 17:27:33 2015 +0100
Remove scm_from_contiguous_array, array 'contiguous' flag scm_from_contiguous_array() is undocumented, unused within Guile, and can be trivially replaced by make-array + array-copy without requiring contiguity. The related SCM_I_ARRAY_FLAG_CONTIGUOUS (arrays.h) was set by all array-creating functions (make-typed-array, transpose-array, make-shared-array) but it was only used by array-contents, which needed to traverse the dimensions anyway. * libguile/arrays.h (scm_from_contiguous_array): Remove declaration. * libguile/arrays.c (scm_from_contiguous_array): Remove. (scm_make_typed_array, scm_from_contiguous_typed_array): Don't set the contiguous flag. (scm_transpose_array, scm_make_shared_array): Don't call scm_i_ra_set_contp. (scm_array_contents): Inline scm_i_ra_set_contp() here. Adopt uniform type check order. Remove redundant comments. (scm_i_ra_set_contp): Remove. * test-suite/tests/arrays.test: Test array-contents with rank 0 array. --- libguile/arrays.c | 112 +++++++++++------------------------------- libguile/arrays.h | 4 +- test-suite/tests/arrays.test | 6 +++ 3 files changed, 36 insertions(+), 86 deletions(-) diff --git a/libguile/arrays.c b/libguile/arrays.c index 52fe90a..3cb547f 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -188,7 +188,6 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1, SCM ra; ra = scm_i_shap2ra (bounds); - SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); s = SCM_I_ARRAY_DIMS (ra); k = SCM_I_ARRAY_NDIM (ra); @@ -225,7 +224,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, size_t sz; ra = scm_i_shap2ra (bounds); - SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); s = SCM_I_ARRAY_DIMS (ra); k = SCM_I_ARRAY_NDIM (ra); @@ -270,41 +268,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, } #undef FUNC_NAME -SCM -scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len) -#define FUNC_NAME "scm_from_contiguous_array" -{ - size_t k, rlen = 1; - scm_t_array_dim *s; - SCM ra; - scm_t_array_handle h; - - ra = scm_i_shap2ra (bounds); - SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); - s = SCM_I_ARRAY_DIMS (ra); - k = SCM_I_ARRAY_NDIM (ra); - - while (k--) - { - s[k].inc = rlen; - SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1); - rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc; - } - if (rlen != len) - SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL); - - SCM_I_ARRAY_SET_V (ra, scm_c_make_vector (rlen, SCM_UNDEFINED)); - scm_array_get_handle (ra, &h); - memcpy (h.writable_elements, elts, rlen * sizeof(SCM)); - scm_array_handle_release (&h); - - if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra)) - if (0 == s->lbnd) - return SCM_I_ARRAY_V (ra); - return ra; -} -#undef FUNC_NAME - SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1, (SCM fill, SCM bounds), "Create and return an array.") @@ -314,27 +277,6 @@ SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1, } #undef FUNC_NAME -static void -scm_i_ra_set_contp (SCM ra) -{ - size_t k = SCM_I_ARRAY_NDIM (ra); - if (k) - { - ssize_t inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc; - while (k--) - { - if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc) - { - SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra); - return; - } - inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd - - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1); - } - } - SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); -} - SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, (SCM oldra, SCM mapfunc, SCM dims), @@ -448,7 +390,6 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, return scm_make_generalized_vector (scm_array_type (ra), SCM_INUM0, SCM_UNDEFINED); } - scm_i_ra_set_contp (ra); return ra; } #undef FUNC_NAME @@ -547,16 +488,12 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, } if (ndim > 0) SCM_MISC_ERROR ("bad argument list", SCM_EOL); - scm_i_ra_set_contp (res); return res; } } #undef FUNC_NAME -/* attempts to unroll an array into a one-dimensional array. - returns the unrolled array or #f if it can't be done. */ -/* if strict is true, return #f if returned array - wouldn't have contiguous elements. */ + SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, (SCM ra, SCM strict), "If @var{ra} may be @dfn{unrolled} into a one dimensional shared\n" @@ -566,31 +503,38 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, "@code{make-array} and @code{make-uniform-array} may be unrolled,\n" "some arrays made by @code{make-shared-array} may not be. If\n" "the optional argument @var{strict} is provided, a shared array\n" - "will be returned only if its elements are stored internally\n" - "contiguous in memory.") + "will be returned only if its elements are stored contiguously\n" + "in memory.") #define FUNC_NAME s_scm_array_contents { - if (!scm_is_array (ra)) - scm_wrong_type_arg_msg (NULL, 0, ra, "array"); - else if (SCM_I_ARRAYP (ra)) + if (SCM_I_ARRAYP (ra)) { SCM v; - size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1; - if (!SCM_I_ARRAY_CONTP (ra)) - return SCM_BOOL_F; - for (k = 0; k < ndim; k++) - len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1; + size_t ndim = SCM_I_ARRAY_NDIM (ra); + scm_t_array_dim *s = SCM_I_ARRAY_DIMS (ra); + size_t k = ndim; + size_t len = 1; + + if (k) + { + ssize_t last_inc = s[k - 1].inc; + while (k--) + { + if (len*last_inc != s[k].inc) + return SCM_BOOL_F; + len *= (s[k].ubnd - s[k].lbnd + 1); + } + } + if (!SCM_UNBNDP (strict) && scm_is_true (strict)) { - if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc)) + if (ndim && (1 != s[ndim - 1].inc)) return SCM_BOOL_F; - if (scm_is_bitvector (SCM_I_ARRAY_V (ra))) - { - if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) || - SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT || - len % SCM_LONG_BIT) - return SCM_BOOL_F; - } + if (scm_is_bitvector (SCM_I_ARRAY_V (ra)) + && (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) || + SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT || + len % SCM_LONG_BIT)) + return SCM_BOOL_F; } v = SCM_I_ARRAY_V (ra); @@ -607,8 +551,10 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, return sra; } } - else + else if (scm_is_array (ra)) return ra; + else + scm_wrong_type_arg_msg (NULL, 0, ra, "array"); } #undef FUNC_NAME diff --git a/libguile/arrays.h b/libguile/arrays.h index 5f40597..4baa51e 100644 --- a/libguile/arrays.h +++ b/libguile/arrays.h @@ -37,8 +37,6 @@ /** Arrays */ SCM_API SCM scm_make_array (SCM fill, SCM bounds); -SCM_API SCM scm_from_contiguous_array (SCM bounds, const SCM *elts, - size_t len); SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds); SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, @@ -54,7 +52,7 @@ SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst); /* internal. */ -#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0) +#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0) /* currently unused */ #define SCM_I_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc7_array, a) #define SCM_I_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x)>>17)) diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test index 20cb78b..6f37196 100644 --- a/test-suite/tests/arrays.test +++ b/test-suite/tests/arrays.test @@ -294,6 +294,12 @@ (with-test-prefix/c&e "array-contents" + (pass-if "0-rank array" + (let ((a (make-vector 1 77))) + (and + (eq? a (array-contents (make-shared-array a (const '(0))))) + (eq? a (array-contents (make-shared-array a (const '(0))) #t))))) + (pass-if "simple vector" (let* ((a (make-array 0 4))) (eq? a (array-contents a))))