mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 13:00:26 +02:00
Code Activity

Avoid unneeded internal use of array handles

Browse source 
* 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.
This commit is contained in:
Daniel Llorens 2015-02-09 12:11:52 +01:00
parent 818def8b1e
commit 00ced1e109
5 changed files with 109 additions and 59 deletions
Download patch file Download diff file Expand all files Collapse all files

65
libguile/arrays.c
View file

@ -64,6 +64,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.")
@ -71,10 +92,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
@ -84,13 +105,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
@ -100,18 +120,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