From c545f7164a80586ac287c551b089101387319e8c Mon Sep 17 00:00:00 2001 From: Daniel Llorens Date: Sat, 20 Apr 2013 01:27:42 +0200 Subject: Refactor array-contents * libguile/arrays.c (scm_array_contents): Branch cases not on scm_is_generalized_vector but on SCM_I_ARRAYP. Thus lbnd!=0, which could happen with scm_is_generalized_vector, never appears in the output. * test-suite/tests/arrays.test: Test array-contents. --- libguile/arrays.c | 42 ++++++++++++++++++++---------------------- 1 file changed, 20 insertions(+), 22 deletions(-) (limited to 'libguile/arrays.c') diff --git a/libguile/arrays.c b/libguile/arrays.c index 84d0f71fb..413a6f4c1 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -563,15 +563,13 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, "contiguous in memory.") #define FUNC_NAME s_scm_array_contents { - SCM sra; - - if (scm_is_generalized_vector (ra)) - return ra; - - if (SCM_I_ARRAYP (ra)) + if (!scm_is_array (ra)) + scm_wrong_type_arg_msg (NULL, 0, ra, "array"); + else if (SCM_I_ARRAYP (ra)) { + SCM v; size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1; - if (!SCM_I_ARRAYP (ra) || !SCM_I_ARRAY_CONTP (ra)) + 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; @@ -588,23 +586,23 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, } } - { - SCM v = SCM_I_ARRAY_V (ra); - size_t length = scm_c_array_length (v); - if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS (ra)->inc) - return v; - } - - sra = scm_i_make_array (1); - SCM_I_ARRAY_DIMS (sra)->lbnd = 0; - SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1; - SCM_I_ARRAY_V (sra) = SCM_I_ARRAY_V (ra); - SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra); - SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1); - return sra; + v = SCM_I_ARRAY_V (ra); + if ((len == scm_c_array_length (v)) && (0 == SCM_I_ARRAY_BASE (ra)) + && SCM_I_ARRAY_DIMS (ra)->inc) + return v; + else + { + SCM sra = scm_i_make_array (1); + SCM_I_ARRAY_DIMS (sra)->lbnd = 0; + SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1; + SCM_I_ARRAY_V (sra) = v; + SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra); + SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1); + return sra; + } } else - scm_wrong_type_arg_msg (NULL, 0, ra, "array"); + return ra; } #undef FUNC_NAME -- cgit v1.2.3