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

151
libguile/vectors.c
View file

@ -408,31 +408,53 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
"@var{start1} is greater than @var{start2}.") "@var{start1} is greater than @var{start2}.")
#define FUNC_NAME s_scm_vector_move_left_x #define FUNC_NAME s_scm_vector_move_left_x
{ {
scm_t_array_handle handle1, handle2; if (SCM_I_IS_VECTOR (vec1) && SCM_I_IS_VECTOR (vec2))
const SCM *elts1; {
SCM *elts2; SCM_VALIDATE_MUTABLE_VECTOR (1, vec2);
size_t len1, len2; const SCM *elts1 = SCM_I_VECTOR_ELTS (vec1);
ssize_t inc1, inc2; SCM *elts2 = SCM_I_VECTOR_WELTS (vec2);
size_t i, j, e; size_t len1 = SCM_I_VECTOR_LENGTH (vec1);
size_t len2 = SCM_I_VECTOR_LENGTH (vec2);
elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
i = scm_to_unsigned_integer (start1, 0, len1); size_t i, j, e;
e = scm_to_unsigned_integer (end1, i, len1); i = scm_to_unsigned_integer (start1, 0, len1);
SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2); e = scm_to_unsigned_integer (end1, i, len1);
j = scm_to_unsigned_integer (start2, 0, len2); SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i)); j = scm_to_unsigned_integer (start2, 0, len2);
SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
i *= inc1; for (; i < e; ++i, ++j)
e *= inc1; elts2[j] = elts1[i];
j *= inc2; }
for (; i < e; i += inc1, j += inc2) else
elts2[j] = elts1[i]; {
scm_t_array_handle handle1, handle2;
const SCM *elts1;
SCM *elts2;
size_t len1, len2;
ssize_t inc1, inc2;
size_t i, j, e;
scm_array_handle_release (&handle2); elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
scm_array_handle_release (&handle1); 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);
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));
i *= inc1;
e *= inc1;
j *= inc2;
for (; i < e; i += inc1, j += inc2)
elts2[j] = elts1[i];
scm_array_handle_release (&handle2);
scm_array_handle_release (&handle1);
}
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -448,36 +470,65 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
"@var{start1} is less than @var{start2}.") "@var{start1} is less than @var{start2}.")
#define FUNC_NAME s_scm_vector_move_right_x #define FUNC_NAME s_scm_vector_move_right_x
{ {
scm_t_array_handle handle1, handle2; if (SCM_I_IS_VECTOR (vec1) && SCM_I_IS_VECTOR (vec2))
const SCM *elts1;
SCM *elts2;
size_t len1, len2;
ssize_t inc1, inc2;
size_t i, j, e;
elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
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);
i *= inc1;
e *= inc1;
j *= inc2;
while (i < e)
{ {
e -= inc1; SCM_VALIDATE_MUTABLE_VECTOR (1, vec2);
j -= inc2; const SCM *elts1 = SCM_I_VECTOR_ELTS (vec1);
elts2[j] = elts1[e]; SCM *elts2 = SCM_I_VECTOR_WELTS (vec2);
} size_t len1 = SCM_I_VECTOR_LENGTH (vec1);
size_t len2 = SCM_I_VECTOR_LENGTH (vec2);
scm_array_handle_release (&handle2); size_t i, j, e;
scm_array_handle_release (&handle1); 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;
size_t len1, len2;
ssize_t inc1, inc2;
size_t i, j, e;
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);
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);
i *= inc1;
e *= inc1;
j *= inc2;
while (i < e)
{
e -= inc1;
j -= inc2;
elts2[j] = elts1[e];
}
scm_array_handle_release (&handle2);
scm_array_handle_release (&handle1);
}
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }