(SCM_IS_UVEC): New, use it instead of

SCM_SMOB_PREDICATE in this file.
(is_uvec): Also recognize one-dimensional uniform numeric arrays
of the right type.
(scm_is_uniform_vector): Likewise.
(uvec_fast_ref): Made BASE param const.
(uvec_writable_elements, uvec_elements): New.
(uvec_to_list, uvec_ref, uvec_set_x, uvec_length,
scm_c_uniform_vector_length, scm_c_uniform_vector_ref,
scm_c_uniform_set_x): Use them to also deal with one-dimensional
arrays.
(scm_uniform_vector_ref, scm_uniform_vector_set_x): Deprecate old
argument convention.
(scm_uniform_vector_to_list): Let uvec_to_list do all the
checking.
(scm_uniform_vector_length): Use uvec_length.

libguile/srfi-4.c

@@ -48,6 +48,7 @@
 /* Smob type code for homogeneous numeric vectors.  */
 int scm_tc16_uvec = 0;
 
+#define SCM_IS_UVEC(obj) SCM_SMOB_PREDICATE (scm_tc16_uvec, (obj))
 
 /* Accessor macros for the three components of a homogeneous numeric
    vector:
@@ -233,8 +234,14 @@ uvec_free (SCM uvec)
 static SCM_C_INLINE int
 is_uvec (int type, SCM obj)
 {
-  return (SCM_SMOB_PREDICATE (scm_tc16_uvec, obj)
+  if (SCM_IS_UVEC (obj))
-	  && SCM_UVEC_TYPE (obj) == type);
+    return SCM_UVEC_TYPE (obj) == type;
+  if (SCM_ARRAYP (obj) && SCM_ARRAY_NDIM (obj) == 1)
+    {
+      SCM v = SCM_ARRAY_V (obj);
+      return SCM_IS_UVEC (v) && SCM_UVEC_TYPE (v) == type;
+    }
+  return 0;
 }
 
 static SCM_C_INLINE SCM
@@ -273,7 +280,7 @@ alloc_uvec (int type, size_t len)
 */
 
 static SCM_C_INLINE SCM
-uvec_fast_ref (int type, void *base, size_t c_idx)
+uvec_fast_ref (int type, const void *base, size_t c_idx)
 {
   if (type == SCM_UVEC_U8)
     return scm_from_uint8 (((scm_t_uint8*)base)[c_idx]);
@@ -359,54 +366,89 @@ make_uvec (int type, SCM len, SCM fill)
   return uvec;
 }
 
+static SCM_C_INLINE void *
+uvec_writable_elements (int type, SCM uvec, scm_t_array_handle *handle,
+			size_t *lenp, ssize_t *incp)
+{
+  if (type >= 0)
+    {
+      SCM v = uvec;
+      if (SCM_ARRAYP (v))
+	v = SCM_ARRAY_V (v);
+      uvec_assert (type, v);
+    }
+
+  return scm_uniform_vector_writable_elements (uvec, handle, lenp, incp);
+}
+
+static SCM_C_INLINE const void *
+uvec_elements (int type, SCM uvec, scm_t_array_handle *handle,
+	       size_t *lenp, ssize_t *incp)
+{
+  return uvec_writable_elements (type, uvec, handle, lenp, incp);
+}
+
+static SCM
+uvec_to_list (int type, SCM uvec)
+{
+  scm_t_array_handle handle;
+  size_t len;
+  ssize_t i, inc;
+  const void *elts;
+  SCM res = SCM_EOL;
+
+  elts = uvec_elements (type, uvec, &handle, &len, &inc);
+  for (i = len*inc; i > 0;)
+    {
+      i -= inc;
+      res = scm_cons (uvec_fast_ref (type, elts, i), res);
+    }
+  scm_array_handle_release (&handle);
+  return res;
+}
+
 static SCM_C_INLINE SCM
 uvec_length (int type, SCM uvec)
 {
-  uvec_assert (type, uvec);
+  scm_t_array_handle handle;
-  return scm_from_size_t (SCM_UVEC_LENGTH (uvec));
+  size_t len;
+  ssize_t inc;
+  uvec_elements (type, uvec, &handle, &len, &inc);
+  scm_array_handle_release (&handle);
+  return scm_from_size_t (len);
 }
 
 static SCM_C_INLINE SCM
 uvec_ref (int type, SCM uvec, SCM idx)
 {
-  size_t c_idx;
+  scm_t_array_handle handle;
+  size_t i, len;
+  ssize_t inc;
+  const void *elts;
   SCM res;
 
-  uvec_assert (type, uvec);
+  elts = uvec_elements (type, uvec, &handle, &len, &inc);
-  c_idx = scm_to_unsigned_integer (idx, 0, SCM_UVEC_LENGTH (uvec)-1);
+  i = scm_to_unsigned_integer (idx, 0, len-1);
-  res = uvec_fast_ref (type, SCM_UVEC_BASE(uvec), c_idx);
+  res = uvec_fast_ref (type, elts, i*inc);
-  scm_remember_upto_here_1 (uvec);
+  scm_array_handle_release (&handle);
   return res;
 }
 
 static SCM_C_INLINE SCM
 uvec_set_x (int type, SCM uvec, SCM idx, SCM val)
 {
-  size_t c_idx;
+  scm_t_array_handle handle;
+  size_t i, len;
+  ssize_t inc;
+  void *elts;
 
-  uvec_assert (type, uvec);
+  elts = uvec_writable_elements (type, uvec, &handle, &len, &inc);
-  c_idx = scm_to_unsigned_integer (idx, 0, SCM_UVEC_LENGTH (uvec)-1);
+  i = scm_to_unsigned_integer (idx, 0, len-1);
-  uvec_fast_set_x (type, SCM_UVEC_BASE(uvec), c_idx, val);
+  uvec_fast_set_x (type, elts, i*inc, val);
-  scm_remember_upto_here_1 (uvec);
+  scm_array_handle_release (&handle);
   return SCM_UNSPECIFIED;
 }
 
-static SCM_C_INLINE SCM
-uvec_to_list (int type, SCM uvec)
-{
-  size_t c_idx;
-  void *base;
-  SCM res = SCM_EOL;
-
-  uvec_assert (type, uvec);
-  c_idx = SCM_UVEC_LENGTH (uvec);
-  base = SCM_UVEC_BASE (uvec);
-  while (c_idx-- > 0)
-    res = scm_cons (uvec_fast_ref (type, base, c_idx), res);
-  scm_remember_upto_here_1 (uvec);
-  return res;
-}
-
 static SCM_C_INLINE SCM
 list_to_uvec (int type, SCM list)
 {
@@ -470,16 +512,35 @@ scm_i_generalized_vector_type (SCM v)
 int
 scm_is_uniform_vector (SCM obj)
 {
-  return SCM_SMOB_PREDICATE (scm_tc16_uvec, obj);
+  if (SCM_IS_UVEC (obj))
+    return 1;
+  if (SCM_ARRAYP (obj) && SCM_ARRAY_NDIM (obj) == 1)
+    {
+      SCM v = SCM_ARRAY_V (obj);
+      return SCM_IS_UVEC (v);
+    }
+  return 0;
 }
 
 size_t
-scm_c_uniform_vector_length (SCM v)
+scm_c_uniform_vector_length (SCM uvec)
 {
-  if (scm_is_uniform_vector (v))
+  /* scm_generalized_vector_get_handle will ultimately call us to get
-    return SCM_UVEC_LENGTH (v);
+     the length of uniform vectors, so we can't use uvec_elements for
+     naked vectors.
+  */
+
+  if (SCM_IS_UVEC (uvec))
+    return SCM_UVEC_LENGTH (uvec);
   else
-    scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
+    {
+      scm_t_array_handle handle;
+      size_t len;
+      ssize_t inc;
+      uvec_elements (-1, uvec, &handle, &len, &inc);
+      scm_array_handle_release (&handle);
+      return len;
+    }
 }
 
 SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
@@ -491,40 +552,59 @@ SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM
+scm_c_uniform_vector_ref (SCM v, size_t idx)
+{
+  scm_t_array_handle handle;
+  const void *elts;
+  size_t len;
+  ssize_t inc;
+  SCM res;
+
+  elts = uvec_elements (-1, v, &handle, &len, &inc);
+  if (idx >= len)
+    scm_out_of_range (NULL, scm_from_size_t (idx));
+  res = uvec_fast_ref (SCM_UVEC_TYPE (v), elts, idx*inc);
+  scm_array_handle_release (&handle);
+  return res;
+}
+
 SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
 	    (SCM v, SCM idx),
 	    "Return the element at index @var{idx} of the\n"
 	    "homogenous numeric vector @var{v}.")
 #define FUNC_NAME s_scm_uniform_vector_ref
 {
+#if SCM_ENABLE_DEPRECATED
   /* Support old argument convention.
    */
   if (scm_is_pair (idx))
     {
+      scm_c_issue_deprecation_warning
+	("Using a list as the index to uniform-vector-ref is deprecated.");
       if (!scm_is_null (SCM_CDR (idx)))
 	scm_wrong_num_args (NULL);
       idx = SCM_CAR (idx);
     }
+#endif
 
-  if (scm_is_uniform_vector (v))
+  return scm_c_uniform_vector_ref (v, scm_to_size_t (idx));
-    return uvec_ref (SCM_UVEC_TYPE (v), v, idx);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
 }
 #undef FUNC_NAME
 
-SCM
+void
-scm_c_uniform_vector_ref (SCM v, size_t idx)
+scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
 {
-  if (scm_is_uniform_vector (v))
+  scm_t_array_handle handle;
-    {
+  void *elts;
-      if (idx < SCM_UVEC_LENGTH (v))
+  size_t len;
-	return uvec_fast_ref (SCM_UVEC_TYPE (v), SCM_UVEC_BASE (v), idx);
+  ssize_t inc;
-      else
+
-	scm_out_of_range (NULL, scm_from_size_t (idx));
+  elts = uvec_writable_elements (-1, v, &handle, &len, &inc);
-    }
+  if (idx >= len)
-  else
+    scm_out_of_range (NULL, scm_from_size_t (idx));
-    scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
+  uvec_fast_set_x (SCM_UVEC_TYPE (v), elts, idx*inc, val);
+  scm_array_handle_release (&handle);
 }
 
 SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
@@ -533,45 +613,30 @@ SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
 	    "homogenous numeric vector @var{v} to @var{val}.")
 #define FUNC_NAME s_scm_uniform_vector_set_x
 {
+#if SCM_ENABLE_DEPRECATED
   /* Support old argument convention.
    */
   if (scm_is_pair (idx))
     {
+      scm_c_issue_deprecation_warning
+	("Using a list as the index to uniform-vector-set! is deprecated.");
       if (!scm_is_null (SCM_CDR (idx)))
 	scm_wrong_num_args (NULL);
       idx = SCM_CAR (idx);
     }
+#endif
 
-  if (scm_is_uniform_vector (v))
+  scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val);
-    return uvec_set_x (SCM_UVEC_TYPE (v), v, idx, val);
+  return SCM_UNSPECIFIED;
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
 }
 #undef FUNC_NAME
 
-void
-scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
-{
-  if (scm_is_uniform_vector (v))
-    {
-      if (idx < SCM_UVEC_LENGTH (v))
-	uvec_fast_set_x (SCM_UVEC_TYPE (v), SCM_UVEC_BASE (v), idx, val);
-      else
-	scm_out_of_range (NULL, scm_from_size_t (idx));
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
-}
-
 SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
             (SCM uvec),
 	    "Convert the homogeneous numeric vector @var{uvec} to a list.")
 #define FUNC_NAME s_scm_uniform_vector_to_list
 {
-  if (scm_is_uniform_vector (uvec))
+  return uvec_to_list (-1, uvec);
-    return uvec_to_list (SCM_UVEC_TYPE (uvec), uvec);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, uvec, "uniform vector");
 }
 #undef FUNC_NAME
 
@@ -591,7 +656,7 @@ scm_array_handle_uniform_element_size (scm_t_array_handle *h)
 size_t
 scm_uniform_element_size (SCM obj)
 {
-  if (scm_is_uniform_vector (obj))
+  if (SCM_IS_UVEC (obj))
     return uvec_sizes[SCM_UVEC_TYPE(obj)];
   else
     return 0;
@@ -609,7 +674,7 @@ scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
   SCM vec = h->array;
   if (SCM_ARRAYP (vec))
     vec = SCM_ARRAY_V (vec);
-  if (scm_is_uniform_vector (vec))
+  if (SCM_IS_UVEC (vec))
     {
       size_t size = uvec_sizes[SCM_UVEC_TYPE(vec)];
       char *elts = SCM_UVEC_BASE (vec);
@@ -646,7 +711,7 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
 	    "Return the number of elements in the uniform vector @var{v}.")
 #define FUNC_NAME s_scm_uniform_vector_length
 {
-  return scm_from_size_t (scm_c_uniform_vector_length (v));
+  return uvec_length (-1, v);
 }
 #undef FUNC_NAME