From 1aa7e85068e02fa4c99ffac13deefab125d88c56 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Fri, 12 Apr 2013 17:50:09 +0200
Subject: [PATCH 22/22] 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 | 39 ++++++++++++++++++++++++++-------------
 libguile/arrays.c       | 47 +----------------------------------------------
 libguile/bitvectors.c   |  1 +
 libguile/bytevectors.c  |  1 +
 libguile/strings.c      |  1 +
 libguile/vectors.c      |  5 +++--
 6 files changed, 33 insertions(+), 61 deletions(-)

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 08778f3..f298f28 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -61,19 +61,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 191d02d..6397067 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -817,52 +817,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 0158490..c05a327 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 cf41f2f..fc576e7 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -2214,6 +2214,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 1b241e5..df60bd3 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -2395,6 +2395,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 94399b0..ef6b02e 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -530,7 +530,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];
 }
@@ -538,7 +538,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;
 }
@@ -546,6 +546,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;
-- 
1.8.2

