[Guile-commits] 14/16: Do not use array handles in scm_vector

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit e1f57b3846a9a22233285f27ab530cf07221025c
Author: Daniel Llorens <address@hidden>
Date:   Wed Feb 25 09:47:40 2015 +0100

    Do not use array handles in scm_vector
    
    * libguile/vectors.c (scm_vector): Use SCM_I_VECTOR_WELTS on new vector
      instead of generic scm_vector_elements; cf. scm_vector_copy().
    
      (scm_vector_elements): Forward to scm_vector_writable_elements().
    
      (scm_vector_writable_elements): Remove special error message for weak
      vector arg.
    
    * libguile/generalized-vectors.c (SCM_VALIDATE_VECTOR_WITH_HANDLE):
      Remove unused macro.
    
    * libguile/array-handle.c (scm_array_handle_elements): Forward to
      scm_array_handle_writable_elements().
---
 libguile/array-handle.c        |    4 +--
 libguile/generalized-vectors.c |    4 ---
 libguile/vectors.c             |   52 ++++++++++++++--------------------------
 3 files changed, 19 insertions(+), 41 deletions(-)

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 17be456..5da4871 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -320,9 +320,7 @@ scm_array_handle_release (scm_t_array_handle *h)
 const SCM *
 scm_array_handle_elements (scm_t_array_handle *h)
 {
-  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
-    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-  return ((const SCM*)h->elements) + h->base;
+  return scm_array_handle_writable_elements (h);
 }
 
 SCM *
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index 308cf6e..5a89332 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -70,10 +70,6 @@ SCM_DEFINE (scm_make_generalized_vector, 
"make-generalized-vector", 2, 1, 0,
 #undef FUNC_NAME
 
 
-#define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle)   \
-  scm_generalized_vector_get_handle (val, handle)
-
-
 void
 scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
 {
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 5dab545..0149dca 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -59,26 +59,13 @@ const SCM *
 scm_vector_elements (SCM vec, scm_t_array_handle *h,
                     size_t *lenp, ssize_t *incp)
 {
-  if (SCM_I_WVECTP (vec))
-    scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
-
-  scm_generalized_vector_get_handle (vec, h);
-  if (lenp)
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (h);
-      *lenp = dim->ubnd - dim->lbnd + 1;
-      *incp = dim->inc;
-    }
-  return scm_array_handle_elements (h);
+  return scm_vector_writable_elements (vec, h, lenp, incp);
 }
 
 SCM *
 scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
                              size_t *lenp, ssize_t *incp)
 {
-  if (SCM_I_WVECTP (vec))
-    scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
-
   scm_generalized_vector_get_handle (vec, h);
   if (lenp)
     {
@@ -89,7 +76,7 @@ scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
   return scm_array_handle_writable_elements (h);
 }
 
-SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, 
+SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
            (SCM obj),
            "Return @code{#t} if @var{obj} is a vector, otherwise return\n"
            "@code{#f}.")
@@ -99,7 +86,7 @@ SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vector_length, "vector-length", 1, 0, 0, 
+SCM_DEFINE (scm_vector_length, "vector-length", 1, 0, 0,
            (SCM v),
             "Returns the number of elements in @var{vector} as an exact 
integer.")
 #define FUNC_NAME s_scm_vector_length
@@ -127,7 +114,7 @@ SCM_REGISTER_PROC (s_list_to_vector, "list->vector", 1, 0, 
0, scm_vector);
            "(list->vector '(dididit dah)) @result{}   #(dididit dah)\n"
            "@end lisp")
 */
-SCM_DEFINE (scm_vector, "vector", 0, 0, 1, 
+SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
            (SCM l),
            "@deffnx {Scheme Procedure} list->vector l\n"
            "Return a newly allocated vector composed of the\n"
@@ -141,27 +128,24 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
   SCM res;
   SCM *data;
   long i, len;
-  scm_t_array_handle handle;
 
   SCM_VALIDATE_LIST_COPYLEN (1, l, len);
 
   res = scm_c_make_vector (len, SCM_UNSPECIFIED);
-  data = scm_vector_writable_elements (res, &handle, NULL, NULL);
+  data = SCM_I_VECTOR_WELTS (res);
   i = 0;
-  while (scm_is_pair (l) && i < len) 
+  while (scm_is_pair (l) && i < len)
     {
       data[i] = SCM_CAR (l);
       l = SCM_CDR (l);
       i += 1;
     }
 
-  scm_array_handle_release (&handle);
-
   return res;
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vector_ref, "vector-ref", 2, 0, 0, 
+SCM_DEFINE (scm_vector_ref, "vector-ref", 2, 0, 0,
            (SCM vector, SCM k),
             "@var{k} must be a valid index of @var{vector}.\n"
             "@samp{Vector-ref} returns the contents of element @var{k} of\n"
@@ -193,7 +177,7 @@ scm_c_vector_ref (SCM v, size_t k)
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vector_set_x, "vector-set!", 3, 0, 0, 
+SCM_DEFINE (scm_vector_set_x, "vector-set!", 3, 0, 0,
            (SCM vector, SCM k, SCM obj),
             "@var{k} must be a valid index of @var{vector}.\n"
             "@code{Vector-set!} stores @var{obj} in element @var{k} of 
@var{vector}.\n"
@@ -218,7 +202,7 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
   SCM_VALIDATE_VECTOR (1, v);
 
   if (k >= SCM_I_VECTOR_LENGTH (v))
-    scm_out_of_range (NULL, scm_from_size_t (k)); 
+    scm_out_of_range (NULL, scm_from_size_t (k));
 
   SCM_SIMPLE_VECTOR_SET (v, k, obj);
 }
@@ -236,7 +220,7 @@ SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
 
   if (SCM_UNBNDP (fill))
     fill = SCM_UNSPECIFIED;
-  
+
   return scm_c_make_vector (l, fill);
 }
 #undef FUNC_NAME
@@ -285,7 +269,7 @@ SCM_DEFINE (scm_vector_copy, "vector-copy", 1, 0, 0,
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, 
+SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
            (SCM v),
            "Return a newly allocated list composed of the elements of 
@var{v}.\n"
            "\n"
@@ -345,7 +329,7 @@ scm_i_vector_equal_p (SCM x, SCM y)
 }
 
 
-SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0, 
+SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
             (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2),
            "Copy elements from @var{vec1}, positions @var{start1} to 
@var{end1},\n"
            "to @var{vec2} starting at position @var{start2}.  @var{start1} 
and\n"
@@ -362,7 +346,7 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 
0, 0,
   size_t len1, len2;
   ssize_t inc1, inc2;
   size_t i, j, e;
-  
+
   elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
   elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
 
@@ -371,7 +355,7 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 
0, 0,
   SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
   j = scm_to_unsigned_integer (start2, 0, len2);
   SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
-  
+
   i *= inc1;
   e *= inc1;
   j *= inc2;
@@ -385,7 +369,7 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 
0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0, 
+SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
             (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2),
            "Copy elements from @var{vec1}, positions @var{start1} to 
@var{end1},\n"
            "to @var{vec2} starting at position @var{start2}.  @var{start1} 
and\n"
@@ -402,7 +386,7 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 
5, 0, 0,
   size_t len1, len2;
   ssize_t inc1, inc2;
   size_t i, j, e;
-  
+
   elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
   elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
 
@@ -411,9 +395,9 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 
5, 0, 0,
   SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
   j = scm_to_unsigned_integer (start2, 0, len2);
   SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
-  
+
   j += (e - i);
-  
+
   i *= inc1;
   e *= inc1;
   j *= inc2;