summaryrefslogtreecommitdiff
path: root/libguile/vectors.c
diff options
context:
space:
mode:
authorDaniel Llorens <lloda@sarc.name>2021-08-05 17:27:31 +0200
committerDaniel Llorens <lloda@sarc.name>2021-08-06 13:06:51 +0200
commitbfda8d397251cdb88bf1e775c85c41a4d01061ac (patch)
tree47d2edadb563d54c6551a70621fe34d9edefb5b7 /libguile/vectors.c
parent81f12bf86eed96c7ecdf6c9ce40d5abe6c729457 (diff)
downloadguile-bfda8d397251cdb88bf1e775c85c41a4d01061ac.tar.gz
Deprecate use of vector-move-left! and vector-move-right! on non-vector arrays
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.
Diffstat (limited to 'libguile/vectors.c')
-rw-r--r--libguile/vectors.c157
1 files changed, 104 insertions, 53 deletions
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 4b701f7e0..4f95644ef 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -408,31 +408,53 @@ 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
{
- 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);
-
- 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);
-
+ 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;
+ 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-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;
}
#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}.")
#define FUNC_NAME s_scm_vector_move_right_x
{
- 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);
-
- 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)
+ if (SCM_I_IS_VECTOR (vec1) && SCM_I_IS_VECTOR (vec2))
{
- e -= inc1;
- j -= inc2;
- elts2[j] = elts1[e];
+ 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;
+ 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);
}
-
- scm_array_handle_release (&handle2);
- scm_array_handle_release (&handle1);
return SCM_UNSPECIFIED;
}