[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: Deprecate scm_from_contiguous_array
|
From: |
Daniel Llorens |
|
Subject: |
[Guile-commits] 01/01: Deprecate scm_from_contiguous_array |
|
Date: |
Fri, 18 Nov 2016 16:56:25 +0000 (UTC) |
lloda pushed a commit to branch lloda-squash1
in repository guile.
commit 180010821dfe27d58ac03f671c4aa39da90dddae
Author: Daniel Llorens <address@hidden>
Date: Fri Nov 18 16:23:05 2016 +0100
Deprecate scm_from_contiguous_array
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.
---
NEWS | 5 +++
libguile/arrays.c | 91 ++++++++++++++----------------------------
libguile/arrays.h | 10 +++--
libguile/deprecated.c | 40 +++++++++++++++++++
libguile/deprecated.h | 10 +++++
test-suite/tests/arrays.test | 6 +++
6 files changed, 98 insertions(+), 64 deletions(-)
diff --git a/NEWS b/NEWS
index 9221739..e36e264 100644
--- a/NEWS
+++ b/NEWS
@@ -102,6 +102,11 @@ scm_dynwind_block_asyncs.
Use `scm_make_mutex_with_kind' instead. See "Mutexes and Condition
Variables" in the manual, for more.
+** `scm_from_contiguous_array' deprecated
+
+This function was never documented. Use `scm_make-array' and
+`scm_array_copy_x' instead.
+
* Bug fixes
** cancel-thread uses asynchronous interrupts, not pthread_cancel
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 31a1d4f..75e92e1 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -57,12 +57,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)
{
@@ -156,7 +150,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;
@@ -290,41 +284,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.")
@@ -334,6 +293,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)
{
@@ -758,31 +718,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);
@@ -799,8 +766,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
diff --git a/libguile/arrays.h b/libguile/arrays.h
index 977d307..37eea69 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -37,8 +37,6 @@
/** Arrays */
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_from_contiguous_typed_array (SCM type, SCM bounds,
const void *bytes,
@@ -63,7 +61,12 @@ SCM_API SCM scm_array_rank (SCM ra);
/* internal. */
-#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)
+/* see scm_from_contiguous_array for these three */
+#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_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 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);
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 6da604e..0c7503e 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -729,6 +729,46 @@ scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout)
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
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 211266f..8f388d2 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -244,6 +244,16 @@ SCM_DEPRECATED SCM scm_lock_mutex_timed (SCM m, SCM
timeout, SCM owner);
+/* 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);
#endif
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 57c5cef..4c943dd 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -413,6 +413,12 @@
(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"
(let* ((a (make-array 0 4)))
(eq? a (array-contents a))))