mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 01:30:27 +02:00
Code Activity

Deprecate scm_from_contiguous_array

Browse source 
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.
This commit is contained in:
Daniel Llorens 2016-11-18 16:23:05 +01:00
parent 0bd7562c96
commit fa4a22971a
5 changed files with 93 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

91
libguile/arrays.c
View file

@ -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