mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +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 1744d72d21
commit 68eb519089
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" #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 size_t
scm_c_array_rank (SCM array) 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. */ /* Increments will still need to be set. */
static SCM SCM
scm_i_shap2ra (SCM args) scm_i_shap2ra (SCM args)
{ {
scm_t_array_dim *s; scm_t_array_dim *s;
@ -289,41 +283,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
} }
#undef FUNC_NAME #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_DEFINE (scm_make_array, "make-array", 1, 0, 1,
(SCM fill, SCM bounds), (SCM fill, SCM bounds),
"Create and return an array.") "Create and return an array.")
@ -333,6 +292,7 @@ SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
} }
#undef FUNC_NAME #undef FUNC_NAME
/* see scm_from_contiguous_array */
static void static void
scm_i_ra_set_contp (SCM ra) 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" "@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" "some arrays made by @code{make-shared-array} may not be. If\n"
"the optional argument @var{strict} is provided, a shared array\n" "the optional argument @var{strict} is provided, a shared array\n"
"will be returned only if its elements are stored internally\n" "will be returned only if its elements are stored contiguously\n"
"contiguous in memory.") "in memory.")
#define FUNC_NAME s_scm_array_contents #define FUNC_NAME s_scm_array_contents
{ {
if (!scm_is_array (ra)) if (SCM_I_ARRAYP (ra))
scm_wrong_type_arg_msg (NULL, 0, ra, "array");
else if (SCM_I_ARRAYP (ra))
{ {
SCM v; SCM v;
size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1; size_t ndim = SCM_I_ARRAY_NDIM (ra);
if (!SCM_I_ARRAY_CONTP (ra)) scm_t_array_dim *s = SCM_I_ARRAY_DIMS (ra);
return SCM_BOOL_F; size_t k = ndim;
for (k = 0; k < ndim; k++) size_t len = 1;
len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 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 (!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; return SCM_BOOL_F;
if (scm_is_bitvector (SCM_I_ARRAY_V (ra))) if (scm_is_bitvector (SCM_I_ARRAY_V (ra))
{ && (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) || SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT || len % SCM_LONG_BIT))
len % SCM_LONG_BIT) return SCM_BOOL_F;
return SCM_BOOL_F;
}
} }
v = SCM_I_ARRAY_V (ra); v = SCM_I_ARRAY_V (ra);
@ -798,8 +765,10 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
return sra; return sra;
} }
} }
else else if (scm_is_array (ra))
return ra; return ra;
else
scm_wrong_type_arg_msg (NULL, 0, ra, "array");
} }
#undef FUNC_NAME #undef FUNC_NAME

8
libguile/arrays.h
View file

@ -37,8 +37,6 @@
/** Arrays */ /** Arrays */
SCM_API SCM scm_make_array (SCM fill, SCM bounds); 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_make_typed_array (SCM type, SCM fill, SCM bounds);
SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds, SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
const void *bytes, const void *bytes,
@ -63,7 +61,12 @@ SCM_API SCM scm_array_rank (SCM ra);
/* internal. */ /* internal. */
/* see scm_from_contiguous_array for these three */
#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0) #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_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc7_array, a)
#define SCM_I_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x)>>17)) #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 SCM scm_i_make_array (int ndim);
SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state *pstate); 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); SCM_INTERNAL void scm_init_arrays (void);

40
libguile/deprecated.c
View file

@ -729,6 +729,46 @@ scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout)
return scm_unlock_mutex (mx); 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

10
libguile/deprecated.h
View file

@ -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); void scm_i_init_deprecated (void);
#endif #endif

6
test-suite/tests/arrays.test
View file

@ -413,6 +413,12 @@
(with-test-prefix/c&e "array-contents" (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" (pass-if "simple vector"
(let* ((a (make-array 0 4))) (let* ((a (make-array 0 4)))
(eq? a (array-contents a)))) (eq? a (array-contents a))))