diff options
author | Daniel Llorens <daniel.llorens@bluewin.ch> | 2013-04-12 17:50:09 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-01-27 21:45:18 +0100 |
commit | a70333d2968ef945db2188f1720f52ff9b0e54a5 (patch) | |
tree | 220fe83ecd7200f301dfe29f4f1e981a533845b9 /libguile | |
parent | ba7e018b614f0964961dd14c877646d385da3a31 (diff) | |
download | guile-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.
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/array-handle.c | 39 | ||||
-rw-r--r-- | libguile/arrays.c | 47 | ||||
-rw-r--r-- | libguile/bitvectors.c | 1 | ||||
-rw-r--r-- | libguile/bytevectors.c | 1 | ||||
-rw-r--r-- | libguile/strings.c | 1 | ||||
-rw-r--r-- | libguile/vectors.c | 5 |
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; |