summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2013-04-12 17:50:09 +0200
committerAndy Wingo <wingo@pobox.com>2014-01-27 21:45:18 +0100
commita70333d2968ef945db2188f1720f52ff9b0e54a5 (patch)
tree220fe83ecd7200f301dfe29f4f1e981a533845b9
parentba7e018b614f0964961dd14c877646d385da3a31 (diff)
downloadguile-a70333d2968ef945db2188f1720f52ff9b0e54a5.tar.gz
Use underlying vector implementation directly in array handles
* libguile/array-handle.c - scm_array_get_handle: if the object is an array, point impl to the underlying vector instead of array impl, then fix the axes. Avoid calling scm_i_array_implementation_for_obj twice. * libguile/arrays.c - array_handle_ref, array_handle_set, array_get_handle: remove. * libguile/bitvectors.c, libguile/bytevectors.c, libguile/strings.c, libguile/vectors.c: fix base = 0 in the array handle. * libguile/vectors.c: (vector_handle_set, vector_handle_ref): do not use h->dims.
-rw-r--r--libguile/array-handle.c39
-rw-r--r--libguile/arrays.c47
-rw-r--r--libguile/bitvectors.c1
-rw-r--r--libguile/bytevectors.c1
-rw-r--r--libguile/strings.c1
-rw-r--r--libguile/vectors.c5
6 files changed, 33 insertions, 61 deletions
diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 62d8520f3..0611c1bf9 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -62,19 +62,32 @@ scm_i_array_implementation_for_obj (SCM obj)
void
scm_array_get_handle (SCM array, scm_t_array_handle *h)
{
- scm_t_array_implementation *impl = scm_i_array_implementation_for_obj (array);
- if (!impl)
- scm_wrong_type_arg_msg (NULL, 0, array, "array");
- h->array = array;
- h->impl = impl;
- h->base = 0;
- h->ndims = 0;
- h->dims = NULL;
- h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM; /* have to default to
- something... */
- h->elements = NULL;
- h->writable_elements = NULL;
- h->impl->get_handle (array, h);
+ scm_t_array_implementation *impl;
+ if (SCM_I_ARRAYP (array))
+ {
+ SCM v = SCM_I_ARRAY_V (array);
+ impl = scm_i_array_implementation_for_obj (v);
+ h->impl = impl;
+ h->impl->get_handle (v, h);
+ /* this works because the v's impl NEVER uses dims/ndims/base */
+ h->dims = SCM_I_ARRAY_DIMS (array);
+ h->ndims = SCM_I_ARRAY_NDIM (array);
+ h->base = SCM_I_ARRAY_BASE (array);
+ }
+ else
+ {
+ impl = scm_i_array_implementation_for_obj (array);
+ if (impl)
+ {
+ h->impl = impl;
+ /* see bitvector_get_handle, string_get_handle,
+ bytevector_get_handle, vector_get_handle, only ever called
+ from here */
+ h->impl->get_handle (array, h);
+ }
+ else
+ scm_wrong_type_arg_msg (NULL, 0, array, "array");
+ }
}
ssize_t
diff --git a/libguile/arrays.c b/libguile/arrays.c
index dd8448ab5..a743cfe8c 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -818,52 +818,7 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
}
-static SCM
-array_handle_ref (scm_t_array_handle *hh, size_t pos)
-{
- scm_t_array_handle h;
- SCM ret;
- scm_array_get_handle (SCM_I_ARRAY_V (hh->array), &h);
- ret = h.impl->vref (&h, pos);
- scm_array_handle_release (&h);
- return ret;
-}
-
-static void
-array_handle_set (scm_t_array_handle *hh, size_t pos, SCM val)
-{
- scm_t_array_handle h;
- scm_array_get_handle (SCM_I_ARRAY_V (hh->array), &h);
- h.impl->vset (&h, pos, val);
- scm_array_handle_release (&h);
-}
-
-/* FIXME: should be handle for vect? maybe not, because of dims */
-static void
-array_get_handle (SCM array, scm_t_array_handle *h)
-{
- scm_t_array_handle vh;
- scm_array_get_handle (SCM_I_ARRAY_V (array), &vh);
- if (vh.dims[0].inc != 1 || vh.dims[0].lbnd != 0 || vh.base != 0)
- {
- fprintf(stderr, "INC %ld, %ld", vh.dims[0].inc, vh.dims[0].lbnd);
- fflush(stderr);
- abort();
- }
- h->element_type = vh.element_type;
- h->elements = vh.elements;
- h->writable_elements = vh.writable_elements;
- scm_array_handle_release (&vh);
-
- h->dims = SCM_I_ARRAY_DIMS (array);
- h->ndims = SCM_I_ARRAY_NDIM (array);
- h->base = SCM_I_ARRAY_BASE (array);
-}
-
-SCM_ARRAY_IMPLEMENTATION (scm_tc7_array,
- 0x7f,
- array_handle_ref, array_handle_set,
- array_get_handle)
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_array, 0x7f, NULL, NULL, NULL)
void
scm_init_arrays ()
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 2eef1dc56..2d36110d4 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -868,6 +868,7 @@ bitvector_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
static void
bitvector_get_handle (SCM bv, scm_t_array_handle *h)
{
+ h->base = 0;
h->array = bv;
h->ndims = 1;
h->dims = &h->dim0;
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 064c427ed..52b531d02 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -2232,6 +2232,7 @@ bv_handle_set_x (scm_t_array_handle *h, size_t index, SCM val)
static void
bytevector_get_handle (SCM v, scm_t_array_handle *h)
{
+ h->base = 0;
h->array = v;
h->ndims = 1;
h->dims = &h->dim0;
diff --git a/libguile/strings.c b/libguile/strings.c
index 1f492bd0c..9aa6a2180 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -2475,6 +2475,7 @@ string_handle_set (scm_t_array_handle *h, size_t index, SCM val)
static void
string_get_handle (SCM v, scm_t_array_handle *h)
{
+ h->base = 0;
h->array = v;
h->ndims = 1;
h->dims = &h->dim0;
diff --git a/libguile/vectors.c b/libguile/vectors.c
index de6c9271c..ae7c3e9c4 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -436,7 +436,7 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
static SCM
vector_handle_ref (scm_t_array_handle *h, size_t idx)
{
- if (idx > h->dims[0].ubnd)
+ if (idx > h->dim0.ubnd)
scm_out_of_range ("vector-handle-ref", scm_from_size_t (idx));
return ((SCM*)h->elements)[idx];
}
@@ -444,7 +444,7 @@ vector_handle_ref (scm_t_array_handle *h, size_t idx)
static void
vector_handle_set (scm_t_array_handle *h, size_t idx, SCM val)
{
- if (idx > h->dims[0].ubnd)
+ if (idx > h->dim0.ubnd)
scm_out_of_range ("vector-handle-set!", scm_from_size_t (idx));
((SCM*)h->writable_elements)[idx] = val;
}
@@ -452,6 +452,7 @@ vector_handle_set (scm_t_array_handle *h, size_t idx, SCM val)
static void
vector_get_handle (SCM v, scm_t_array_handle *h)
{
+ h->base = 0;
h->array = v;
h->ndims = 1;
h->dims = &h->dim0;