(coerce_to_uvec, scm_any_to_u8vector, etc): New.

(scm_uniform_element_size, scm_uniform_vector_length): Do no longer
handle old-style uniform vectors.

3 files changed, 67 insertions, 61 deletions

diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 5d2497b85..fc88ff1a9 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -406,6 +406,38 @@ list_to_uvec (int type, SCM list)
   return uvec;
 }
 
+static SCM
+coerce_to_uvec (int type, SCM obj)
+{
+  if (is_uvec (type, obj))
+    return obj;
+  else if (scm_is_pair (obj))
+    return list_to_uvec (type, obj);
+  else if (scm_is_true (scm_vector_p (obj)))
+    {
+      SCM len = scm_vector_length (obj);
+      SCM uvec = make_uvec (type, len, SCM_UNDEFINED);
+      size_t clen = scm_to_size_t (len), i;
+      void *base = SCM_UVEC_BASE (uvec);
+      for (i = 0; i < clen; i++)
+	uvec_fast_set_x (type, base, i, SCM_VECTOR_REF (obj, i));
+      return uvec;
+    }
+  else if (scm_is_uniform_vector (obj))
+    {
+      SCM len = scm_uniform_vector_length (obj);
+      SCM uvec = make_uvec (type, len, SCM_UNDEFINED);
+      size_t clen = scm_to_size_t (len), i;
+      void *base = SCM_UVEC_BASE (uvec);
+      for (i = 0; i < clen; i++)
+	uvec_fast_set_x (type, base, i,
+			 scm_uniform_vector_ref (obj, scm_from_size_t (i)));
+      return uvec;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, obj, "list, vector, or uniform vector");
+}
+
 static SCM *uvec_proc_vars[12] = {
   &scm_i_proc_make_u8vector,
   &scm_i_proc_make_s8vector,
@@ -551,45 +583,12 @@ scm_uniform_vector_element_size (SCM uvec)
 size_t
 scm_uniform_element_size (SCM obj)
 {
-  size_t result;
-
   if (scm_is_uniform_vector (obj))
     return scm_uniform_vector_element_size (obj);
-
-  switch (SCM_TYP7 (obj))
-    {
-    case scm_tc7_bvect:
-    case scm_tc7_uvect:
-    case scm_tc7_ivect:
-      result = sizeof (long);
-      break;
-
-    case scm_tc7_svect:
-      result = sizeof (short);
-      break;
-
-#if SCM_SIZEOF_LONG_LONG != 0
-    case scm_tc7_llvect:
-      result = sizeof (long long);
-      break;
-#endif 
-
-    case scm_tc7_fvect:
-      result = sizeof (float);
-      break;
-
-    case scm_tc7_dvect:
-      result = sizeof (double);
-      break;
-
-    case scm_tc7_cvect:
-      result = 2 * sizeof (double);
-      break;
-      
-    default:
-      result = 0;
-    }
-  return result;
+  else if (SCM_BITVECTOR_P (obj))
+    return sizeof (long);
+  else
+    return 0;
 }
 
 SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, 
@@ -599,30 +598,14 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
 {
   if (scm_is_uniform_vector (v))
     return scm_from_size_t (SCM_UVEC_LENGTH (v));
-
-  SCM_ASRTGO (SCM_NIMP (v), badarg1);
-  switch SCM_TYP7 (v)
-    {
-    default:
-    badarg1:SCM_WRONG_TYPE_ARG (1, v);
-    case scm_tc7_vector:
-    case scm_tc7_wvect:
-      return scm_from_size_t (SCM_VECTOR_LENGTH (v));
-    case scm_tc7_string:
-      return scm_from_size_t (scm_i_string_length (v));
-    case scm_tc7_bvect:
-      return scm_from_size_t (SCM_BITVECTOR_LENGTH (v));
-    case scm_tc7_uvect:
-    case scm_tc7_ivect:
-    case scm_tc7_fvect:
-    case scm_tc7_dvect:
-    case scm_tc7_cvect:
-    case scm_tc7_svect:
-#if SCM_SIZEOF_LONG_LONG != 0
-    case scm_tc7_llvect:
-#endif
-      return scm_from_size_t (SCM_UVECTOR_LENGTH (v));
-    }
+  else if (scm_is_string (v))
+    return scm_string_length (v);
+  else if (scm_is_true (scm_vector_p (v)))
+    return scm_vector_length (v);
+  else if (SCM_BITVECTOR_P (v))
+    return scm_from_size_t (SCM_BITVECTOR_LENGTH (v));
+  else
+    scm_wrong_type_arg (NULL, 0, v);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h
index 302f53873..92ef45555 100644
--- a/libguile/srfi-4.h
+++ b/libguile/srfi-4.h
@@ -51,6 +51,7 @@ SCM_API SCM scm_u8vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_u8vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_u8vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_u8vector (SCM l);
+SCM_API SCM scm_any_to_u8vector (SCM obj);
 SCM_API scm_t_uint8 *scm_u8vector_elements (SCM uvec);
 
 SCM_API SCM scm_s8vector_p (SCM obj);
@@ -62,6 +63,7 @@ SCM_API SCM scm_s8vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_s8vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_s8vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_s8vector (SCM l);
+SCM_API SCM scm_any_to_s8vector (SCM obj);
 SCM_API scm_t_int8 *scm_s8vector_elements (SCM uvec);
 
 SCM_API SCM scm_u16vector_p (SCM obj);
@@ -73,6 +75,7 @@ SCM_API SCM scm_u16vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_u16vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_u16vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_u16vector (SCM l);
+SCM_API SCM scm_any_to_u16vector (SCM obj);
 SCM_API scm_t_uint16 *scm_u16vector_elements (SCM uvec);
 
 SCM_API SCM scm_s16vector_p (SCM obj);
@@ -84,6 +87,7 @@ SCM_API SCM scm_s16vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_s16vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_s16vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_s16vector (SCM l);
+SCM_API SCM scm_any_to_s16vector (SCM obj);
 SCM_API scm_t_int16 *scm_s16vector_elements (SCM uvec);
 
 SCM_API SCM scm_u32vector_p (SCM obj);
@@ -95,6 +99,7 @@ SCM_API SCM scm_u32vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_u32vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_u32vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_u32vector (SCM l);
+SCM_API SCM scm_any_to_u32vector (SCM obj);
 SCM_API scm_t_uint32 *scm_u32vector_elements (SCM uvec);
 
 SCM_API SCM scm_s32vector_p (SCM obj);
@@ -106,6 +111,7 @@ SCM_API SCM scm_s32vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_s32vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_s32vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_s32vector (SCM l);
+SCM_API SCM scm_any_to_s32vector (SCM obj);
 SCM_API scm_t_int32 *scm_s32vector_elements (SCM uvec);
 
 SCM_API SCM scm_u64vector_p (SCM obj);
@@ -117,6 +123,7 @@ SCM_API SCM scm_u64vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_u64vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_u64vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_u64vector (SCM l);
+SCM_API SCM scm_any_to_u64vector (SCM obj);
 SCM_API scm_t_uint64 *scm_u64vector_elements (SCM uvec);
 
 SCM_API SCM scm_s64vector_p (SCM obj);
@@ -128,6 +135,7 @@ SCM_API SCM scm_s64vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_s64vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_s64vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_s64vector (SCM l);
+SCM_API SCM scm_any_to_s64vector (SCM obj);
 SCM_API scm_t_int64 *scm_s64vector_elements (SCM uvec);
 
 SCM_API SCM scm_f32vector_p (SCM obj);
@@ -139,6 +147,7 @@ SCM_API SCM scm_f32vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_f32vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_f32vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_f32vector (SCM l);
+SCM_API SCM scm_any_to_f32vector (SCM obj);
 SCM_API float *scm_f32vector_elements (SCM uvec);
 
 SCM_API SCM scm_f64vector_p (SCM obj);
@@ -150,6 +159,7 @@ SCM_API SCM scm_f64vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_f64vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_f64vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_f64vector (SCM l);
+SCM_API SCM scm_any_to_f64vector (SCM obj);
 SCM_API double *scm_f64vector_elements (SCM uvec);
 
 SCM_API SCM scm_c32vector_p (SCM obj);
@@ -161,6 +171,7 @@ SCM_API SCM scm_c32vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_c32vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_c32vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_c32vector (SCM l);
+SCM_API SCM scm_any_to_c32vector (SCM obj);
 SCM_API float *scm_c32vector_elements (SCM uvec);
 
 SCM_API SCM scm_c64vector_p (SCM obj);
@@ -172,6 +183,7 @@ SCM_API SCM scm_c64vector_ref (SCM uvec, SCM index);
 SCM_API SCM scm_c64vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_c64vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_c64vector (SCM l);
+SCM_API SCM scm_any_to_c64vector (SCM obj);
 SCM_API double *scm_c64vector_elements (SCM uvec);
 
 SCM_API SCM scm_i_uniform_vector_creator (SCM uvec);
diff --git a/libguile/srfi-4.i.c b/libguile/srfi-4.i.c
index ca181a1df..755589f38 100644
--- a/libguile/srfi-4.i.c
+++ b/libguile/srfi-4.i.c
@@ -127,6 +127,17 @@ SCM_DEFINE (F(scm_list_to_,TAG,vector), "list->"S(TAG)"vector", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (F(scm_any_to_,TAG,vector), "any->"S(TAG)"vector", 1, 0, 0,
+	    (SCM obj),
+	    "Convert @var{obj}, which can be a list, vector, or\n"
+	    "homogenous vector, to a numeric homogenous vector of\n"
+	    "type " S(TAG)".")
+#define FUNC_NAME s_F(scm_any_to_,TAG,vector)
+{
+  return coerce_to_uvec (TYPE, obj);
+}
+#undef FUNC_NAME
+
 CTYPE *
 F(scm_,TAG,vector_elements) (SCM obj)
 {