From 68eb519089c730799aff89d40aade629fc66ad32 Mon Sep 17 00:00:00 2001 From: Daniel Llorens Date: Fri, 18 Nov 2016 16:23:05 +0100 Subject: Deprecate scm_from_contiguous_array scm_from_contiguous_array() was undocumented, unused within Guile, and can be replaced by make-array + array-copy! without requiring contiguity and without loss of performance. * libguile/arrays.c (scm_array_contents): Do not rely on SCM_I_ARRAY_CONTP. * test-suite/tests/arrays.test: Test array-contents with 0-rank array. * libguile/arrays.h: Declare scm_i_shap2ra(), SCM_SET_ARRAY_CONTIGUOUS_FLAG, SCM_CLR_ARRAY_CONTIGUOUS_FLAG so that scm_from_contiguous_array() can keep using them. * libguile/deprecated.c (scm_from_contiguous_array): Move here from arrays.c. * libguile/deprecated.h (scm_from_contiguous_array): Deprecate. * NEWS: Add deprecation notice. --- libguile/arrays.c | 91 +++++++++++++++----------------------------- libguile/arrays.h | 10 +++-- libguile/deprecated.c | 40 +++++++++++++++++++ libguile/deprecated.h | 10 +++++ test-suite/tests/arrays.test | 6 +++ 5 files changed, 93 insertions(+), 64 deletions(-) diff --git a/libguile/arrays.c b/libguile/arrays.c index 395bb6723..b17c415c2 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -56,12 +56,6 @@ #include "libguile/uniform.h" -#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \ - (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | (SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))) -#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \ - (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))) - - size_t scm_c_array_rank (SCM array) { @@ -155,7 +149,7 @@ static char s_bad_spec[] = "Bad scm_array dimension"; /* Increments will still need to be set. */ -static SCM +SCM scm_i_shap2ra (SCM args) { scm_t_array_dim *s; @@ -289,41 +283,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.") @@ -333,6 +292,7 @@ SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1, } #undef FUNC_NAME +/* see scm_from_contiguous_array */ static void scm_i_ra_set_contp (SCM ra) { @@ -757,31 +717,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); @@ -798,8 +765,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 977d30760..37eea69bd 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, @@ -63,7 +61,12 @@ SCM_API SCM scm_array_rank (SCM ra); /* internal. */ -#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0) +/* see scm_from_contiguous_array for these three */ +#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0) +#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \ + (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | (SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))) +#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \ + (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))) #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)) @@ -78,6 +81,7 @@ SCM_API SCM scm_array_rank (SCM ra); SCM_INTERNAL SCM scm_i_make_array (int ndim); SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state *pstate); +SCM_INTERNAL SCM scm_i_shap2ra (SCM args); SCM_INTERNAL void scm_init_arrays (void); diff --git a/libguile/deprecated.c b/libguile/deprecated.c index e94733806..0ea4b5e20 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -729,6 +729,46 @@ scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout) return scm_unlock_mutex (mx); } + + +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; + + scm_c_issue_deprecation_warning + ("`scm_from_contiguous_array' is deprecated. Use make-array and array-copy!\n" + "instead.\n"); + + 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 diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 782e84564..69f9e1ef0 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -256,6 +256,16 @@ SCM_DEPRECATED SCM scm_apply_with_dynamic_root (SCM proc, SCM a1, +/* Deprecated 2016-11-18. Never documented. Unnecessary, since + array-copy! already unrolls and does it in more general cases. */ +/* With this also remove SCM_I_ARRAY_FLAG_CONTIGUOUS, + SCM_SET_ARRAY_CONTIGUOUS_FLAG, SCM_CLR_ARRAY_CONTIGUOUS_FLAG, + scm_i_ra_set_contp, and uses thereof. */ +SCM_DEPRECATED SCM scm_from_contiguous_array (SCM bounds, const SCM *elts, + size_t len); + + + void scm_i_init_deprecated (void); #endif diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test index 57c5cef3e..4c943dd41 100644 --- a/test-suite/tests/arrays.test +++ b/test-suite/tests/arrays.test @@ -413,6 +413,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)))) -- cgit v1.2.1