diff options
author | Daniel Llorens <daniel.llorens@bluewin.ch> | 2015-02-09 12:11:52 +0100 |
---|---|---|
committer | Daniel Llorens <daniel.llorens@bluewin.ch> | 2016-11-23 11:49:35 +0100 |
commit | 4e766795b2412f42a9c71441e6cc0b36d8a4c5dc (patch) | |
tree | d88c43b4d11a633d4088c1df31f9892aebb3daa8 /libguile/arrays.c | |
parent | d236d4d33fdab83127a4d72c2b561649a5c46b6c (diff) | |
download | guile-4e766795b2412f42a9c71441e6cc0b36d8a4c5dc.tar.gz |
Avoid unneeded internal use of array handles
* libguile/arrays.c (scm_shared_array_root): Adopt uniform check order.
(scm_shared_array_offset, scm_shared_array_increments): Use the array
fields directly just as scm_shared_array_root does.
(scm_c_array_rank): Moved from libguile/generalized-arrays.c. Don't
use array handles, but follow the same type check sequence as the
other array functions (shared-array-root, etc).
(scm_array_rank): Moved from libguile/generalized-arrays.h.
* libguile/arrays.h: Move prototypes here.
* test-suite/tests/arrays.test: Tests for shared-array-offset,
shared-array-increments.
Diffstat (limited to 'libguile/arrays.c')
-rw-r--r-- | libguile/arrays.c | 65 |
1 files changed, 43 insertions, 22 deletions
diff --git a/libguile/arrays.c b/libguile/arrays.c index ea090d646..b8307d528 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -63,6 +63,27 @@ (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) +{ + if (SCM_I_ARRAYP (array)) + return SCM_I_ARRAY_NDIM (array); + else if (scm_is_array (array)) + return 1; + else + scm_wrong_type_arg_msg ("array-rank", SCM_ARG1, array, "array"); +} + +SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, + (SCM array), + "Return the number of dimensions of the array @var{array.}\n") +#define FUNC_NAME s_scm_array_rank +{ + return scm_from_size_t (scm_c_array_rank (array)); +} +#undef FUNC_NAME + + SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, (SCM ra), "Return the root vector of a shared array.") @@ -70,10 +91,10 @@ SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, { if (SCM_I_ARRAYP (ra)) return SCM_I_ARRAY_V (ra); - else if (!scm_is_array (ra)) - scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array"); - else + else if (scm_is_array (ra)) return ra; + else + scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array"); } #undef FUNC_NAME @@ -83,13 +104,12 @@ SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, "Return the root vector index of the first element in the array.") #define FUNC_NAME s_scm_shared_array_offset { - scm_t_array_handle handle; - SCM res; - - scm_array_get_handle (ra, &handle); - res = scm_from_size_t (handle.base); - scm_array_handle_release (&handle); - return res; + if (SCM_I_ARRAYP (ra)) + return scm_from_size_t (SCM_I_ARRAY_BASE (ra)); + else if (scm_is_array (ra)) + return scm_from_size_t (0); + else + scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array"); } #undef FUNC_NAME @@ -99,18 +119,19 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, "For each dimension, return the distance between elements in the root vector.") #define FUNC_NAME s_scm_shared_array_increments { - scm_t_array_handle handle; - SCM res = SCM_EOL; - size_t k; - scm_t_array_dim *s; - - scm_array_get_handle (ra, &handle); - k = scm_array_handle_rank (&handle); - s = scm_array_handle_dims (&handle); - while (k--) - res = scm_cons (scm_from_ssize_t (s[k].inc), res); - scm_array_handle_release (&handle); - return res; + if (SCM_I_ARRAYP (ra)) + { + size_t k = SCM_I_ARRAY_NDIM (ra); + SCM res = SCM_EOL; + scm_t_array_dim *dims = SCM_I_ARRAY_DIMS (ra); + while (k--) + res = scm_cons (scm_from_ssize_t (dims[k].inc), res); + return res; + } + else if (scm_is_array (ra)) + return scm_list_1 (scm_from_ssize_t (1)); + else + scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array"); } #undef FUNC_NAME |