mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Deprecate use of vector-move-left! and vector-move-right! on non-vector arrays

Browse source 
These functions weren't advertised to work on non-vector arrays. They
did try to, but only incorrectly. For example:

  (define a (vector 1 2 3 4 5))
  (define b (make-array 0 '(1 5)))
  (vector-move-right! a 0 2 b 2)
  b
  => #1@1(0 0 1 2 0)

instead of the correct result #1@1(0 1 2 0 0).

* libguile/vectors.c (vector-move-left!, vector-move-right!): As stated.
This commit is contained in:
Daniel Llorens 2021-08-05 17:27:31 +02:00
parent 81f12bf86e
commit bfda8d3972
1 changed files with 101 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

53
libguile/vectors.c
View file

@ -408,6 +408,25 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
"@var{start1} is greater than @var{start2}.")
#define FUNC_NAME s_scm_vector_move_left_x
{
if (SCM_I_IS_VECTOR (vec1) && SCM_I_IS_VECTOR (vec2))
{
SCM_VALIDATE_MUTABLE_VECTOR (1, vec2);
const SCM *elts1 = SCM_I_VECTOR_ELTS (vec1);
SCM *elts2 = SCM_I_VECTOR_WELTS (vec2);
size_t len1 = SCM_I_VECTOR_LENGTH (vec1);
size_t len2 = SCM_I_VECTOR_LENGTH (vec2);
size_t i, j, e;
i = scm_to_unsigned_integer (start1, 0, len1);
e = scm_to_unsigned_integer (end1, i, len1);
SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
j = scm_to_unsigned_integer (start2, 0, len2);
SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
for (; i < e; ++i, ++j)
elts2[j] = elts1[i];
}
else
{
scm_t_array_handle handle1, handle2;
const SCM *elts1;
SCM *elts2;
@ -417,6 +436,9 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
scm_c_issue_deprecation_warning
("Using vector-move-left! on arrays is deprecated. "
"Use array-copy-in-order! instead.");
i = scm_to_unsigned_integer (start1, 0, len1);
e = scm_to_unsigned_integer (end1, i, len1);
@ -432,7 +454,7 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
scm_array_handle_release (&handle2);
scm_array_handle_release (&handle1);
}
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -448,6 +470,31 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
"@var{start1} is less than @var{start2}.")
#define FUNC_NAME s_scm_vector_move_right_x
{
if (SCM_I_IS_VECTOR (vec1) && SCM_I_IS_VECTOR (vec2))
{
SCM_VALIDATE_MUTABLE_VECTOR (1, vec2);
const SCM *elts1 = SCM_I_VECTOR_ELTS (vec1);
SCM *elts2 = SCM_I_VECTOR_WELTS (vec2);
size_t len1 = SCM_I_VECTOR_LENGTH (vec1);
size_t len2 = SCM_I_VECTOR_LENGTH (vec2);
size_t i, j, e;
i = scm_to_unsigned_integer (start1, 0, len1);
e = scm_to_unsigned_integer (end1, i, len1);
SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
j = scm_to_unsigned_integer (start2, 0, len2);
SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
j += (e - i);
while (i < e)
{
--e;
--j;
elts2[j] = elts1[e];
}
}
else
{
scm_t_array_handle handle1, handle2;
const SCM *elts1;
SCM *elts2;
@ -457,6 +504,9 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
scm_c_issue_deprecation_warning
("Using vector-move-right! on arrays is deprecated. "
"Use array-copy-in-order! instead.");
i = scm_to_unsigned_integer (start1, 0, len1);
e = scm_to_unsigned_integer (end1, i, len1);
@ -478,6 +528,7 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
scm_array_handle_release (&handle2);
scm_array_handle_release (&handle1);
}
return SCM_UNSPECIFIED;
}