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.

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);
+  scm_t_array_implementation *impl;
-  if (!impl)
+  if (SCM_I_ARRAYP (array))
-    scm_wrong_type_arg_msg (NULL, 0, array, "array");
+    {
-  h->array = array;
+      SCM v = SCM_I_ARRAY_V (array);
-  h->impl = impl;
+      impl = scm_i_array_implementation_for_obj (v);
-  h->base = 0;
+      h->impl = impl;
-  h->ndims = 0;
+      h->impl->get_handle (v, h);
-  h->dims = NULL;
+      /* this works because the v's impl NEVER uses dims/ndims/base */
-  h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM; /* have to default to
+      h->dims = SCM_I_ARRAY_DIMS (array);
-                                                   something... */
+      h->ndims = SCM_I_ARRAY_NDIM (array);
-  h->elements = NULL;
+      h->base = SCM_I_ARRAY_BASE (array);
-  h->writable_elements = NULL;
+    }
-  h->impl->get_handle (array, h);
+  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

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
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_array, 0x7f, NULL, NULL, NULL)
-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)
 
 void
 scm_init_arrays ()

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;

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;

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;

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;