diff options
author | Daniel Llorens <daniel.llorens@bluewin.ch> | 2015-02-10 17:21:29 +0100 |
---|---|---|
committer | Daniel Llorens <daniel.llorens@bluewin.ch> | 2016-07-11 09:11:50 +0200 |
commit | 212c5b0f299660bddd1c0b2c9645b453be72b4ee (patch) | |
tree | cb079720422319775fb8671a239bfaa5a25ceac1 | |
parent | c557ff68ec84bc29caff45ca71dfe7fc07979059 (diff) | |
download | guile-212c5b0f299660bddd1c0b2c9645b453be72b4ee.tar.gz |
Unuse array 'contiguous' flag
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.c (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.
* libguile/arrays.h: note.
* test-suite/tests/arrays.test: test array-contents with rank 0 array.
-rw-r--r-- | libguile/arrays.c | 77 | ||||
-rw-r--r-- | libguile/arrays.h | 2 | ||||
-rw-r--r-- | test-suite/tests/arrays.test | 6 |
3 files changed, 36 insertions, 49 deletions
diff --git a/libguile/arrays.c b/libguile/arrays.c index 66135425b..c852e64f4 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); @@ -279,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), @@ -413,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 @@ -512,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" @@ -531,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); @@ -572,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 c486f2057..4baa51eb4 100644 --- a/libguile/arrays.h +++ b/libguile/arrays.h @@ -52,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 7c7b46704..fb72e281b 100644 --- a/test-suite/tests/arrays.test +++ b/test-suite/tests/arrays.test @@ -298,6 +298,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)))) |