mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-05 17:20:18 +02:00
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.
This commit is contained in:
Daniel Llorens
parent
c557ff68ec
commit
212c5b0f29
3 changed files with 36 additions and 49 deletions
|
|
@ -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,32 +503,39 @@ 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))
|
||||
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;
|
||||
for (k = 0; k < ndim; k++)
|
||||
len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
|
||||
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)) ||
|
||||
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)
|
||||
len % SCM_LONG_BIT))
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
}
|
||||
|
||||
v = SCM_I_ARRAY_V (ra);
|
||||
if ((len == scm_c_array_length (v)) && (0 == SCM_I_ARRAY_BASE (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
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue