Merge commit '24cac6554073bb6e691605cd6ac6196f3c0851a3'

Conflicts:
	libguile/vectors.c

diff --cc libguile/vectors.c
index 6bbd39a,abcbfa0..1c659de
--- 1/libguile/vectors.c
--- 2/libguile/vectors.c
+++ b/libguile/vectors.c
@@@ -46,20 -47,43 +46,13 @@@
  int
  scm_is_vector (SCM obj)
  {
-   if (SCM_I_IS_VECTOR (obj))
 -  if (SCM_I_IS_NONWEAK_VECTOR (obj))
--    return 1;
-   if  (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
 -  if (SCM_I_WVECTP (obj))
 -    {
 -      scm_c_issue_deprecation_warning
 -        ("Expecting vector? to be true for weak vectors is deprecated.  "
 -         "Use weak-vector? instead.");
 -      return 1;
 -    }
 -  if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
--    {
--      SCM v = SCM_I_ARRAY_V (obj);
-       return SCM_I_IS_VECTOR (v);
 -      if (SCM_I_IS_VECTOR (v))
 -        {
 -          scm_c_issue_deprecation_warning
 -            ("Expecting vector? to be true for rank-1 arrays is deprecated.  "
 -             "Use array?, array-rank, and array-type instead.");
 -          return 1;
 -        }
 -      return 0;
--    }
--  return 0;
++  return SCM_I_IS_NONWEAK_VECTOR (obj);
  }
  
  int
  scm_is_simple_vector (SCM obj)
  {
-   return SCM_I_IS_VECTOR (obj);
 -  if (SCM_I_IS_NONWEAK_VECTOR (obj))
 -    return 1;
 -  if (SCM_I_WVECTP (obj))
 -    {
 -      scm_c_issue_deprecation_warning
 -        ("Expecting scm_is_simple_vector to be true for weak vectors is "
 -         "deprecated.  Use scm_is_weak_vector instead.");
 -      return 1;
 -    }
 -  return 0;
++  return SCM_I_IS_NONWEAK_VECTOR (obj);
  }
  
  const SCM *
@@@ -106,34 -134,48 +99,24 @@@ SCM_DEFINE (scm_vector_p, "vector?", 1
  }
  #undef FUNC_NAME
  
 -SCM_GPROC (s_vector_length, "vector-length", 1, 0, 0, scm_vector_length, g_vector_length);
 -/* Returns the number of elements in @var{vector} as an exact integer.  */
 -SCM
 -scm_vector_length (SCM v)
 +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
  {
-   if (SCM_I_IS_NONWEAK_VECTOR (v))
-     return scm_from_size_t (SCM_I_VECTOR_LENGTH (v));
 -  if (SCM_I_IS_VECTOR (v))
 -    {
 -      if (SCM_I_WVECTP (v))
 -        scm_c_issue_deprecation_warning
 -          ("Using vector-length on weak vectors is deprecated.  "
 -           "Use weak-vector-length from (ice-9 weak-vectors) instead.");
 -      return scm_from_size_t (SCM_I_VECTOR_LENGTH (v));
 -    }
--  else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
--    {
--      scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
 -      scm_c_issue_deprecation_warning
 -        ("Using vector-length on arrays is deprecated.  "
 -         "Use array-length instead.");
--      return scm_from_size_t (dim->ubnd - dim->lbnd + 1);
 -    }
 -  else if (SCM_UNPACK (g_vector_length))
 -    {
 -      scm_c_issue_deprecation_warning
 -        ("Using vector-length as a primitive-generic is deprecated.");
 -      return scm_call_generic_1 (g_vector_length, v);
--    }
--  else
--    {
--      scm_wrong_type_arg_msg ("vector-length", 1, v, "vector");
--      return SCM_UNDEFINED;  /* not reached */
--    }
++  return scm_from_size_t (scm_c_vector_length (v));
  }
 +#undef FUNC_NAME
  
  size_t
  scm_c_vector_length (SCM v)
++#define FUNC_NAME s_scm_vector_length
  {
--  if (SCM_I_IS_NONWEAK_VECTOR (v))
--    return SCM_I_VECTOR_LENGTH (v);
--  else
--    return scm_to_size_t (scm_vector_length (v));
++  SCM_VALIDATE_VECTOR (1, v);
++
++  return SCM_I_VECTOR_LENGTH (v);
  }
++#undef FUNC_NAME
  
  SCM_REGISTER_PROC (s_list_to_vector, "list->vector", 1, 0, 0, scm_vector);
  /*
@@@ -199,78 -246,140 +182,47 @@@ SCM_DEFINE (scm_vector_ref, "vector-ref
  
  SCM
  scm_c_vector_ref (SCM v, size_t k)
++#define FUNC_NAME s_scm_vector_ref
  {
--  if (SCM_I_IS_NONWEAK_VECTOR (v))
-     {
-       if (k >= SCM_I_VECTOR_LENGTH (v))
-       scm_out_of_range (NULL, scm_from_size_t (k));
-       return SCM_SIMPLE_VECTOR_REF (v, k);
-     }
-   else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
--    {
-       scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
-       SCM vv = SCM_I_ARRAY_V (v);
 -      register SCM elt;
++  SCM_VALIDATE_VECTOR (1, v);
  
-       k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
-       if (k >= dim->ubnd - dim->lbnd + 1)
-         scm_out_of_range (NULL, scm_from_size_t (k));
 -      if (k >= SCM_I_VECTOR_LENGTH (v))
 -      scm_out_of_range (NULL, scm_from_size_t (k));
 -      elt = (SCM_I_VECTOR_ELTS(v))[k];
++  if (k >= SCM_I_VECTOR_LENGTH (v))
++    scm_out_of_range (NULL, scm_from_size_t (k));
  
-       if (SCM_I_IS_NONWEAK_VECTOR (vv))
-         return SCM_SIMPLE_VECTOR_REF (vv, k);
-       else
-         scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
 -      return elt;
 -    }
 -  else if (SCM_I_WVECTP (v))
 -    {
 -      scm_c_issue_deprecation_warning
 -        ("Using vector-ref on weak vectors is deprecated.  "
 -         "Instead, use weak-vector-ref from (ice-9 weak-vectors).");
 -      return scm_c_weak_vector_ref (v, k);
 -    }
 -  else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
 -    {
 -      scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
 -      SCM vv = SCM_I_ARRAY_V (v);
 -      if (SCM_I_IS_VECTOR (vv))
 -      {
 -        register SCM elt;
 -
 -          scm_c_issue_deprecation_warning
 -            ("Using vector-ref on arrays is deprecated.  "
 -             "Use array-ref instead.");
 -
 -        if (k >= dim->ubnd - dim->lbnd + 1)
 -          scm_out_of_range (NULL, scm_from_size_t (k));
 -        k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
 -        elt = (SCM_I_VECTOR_ELTS (vv))[k];
 -
 -        if (SCM_UNPACK (elt) == 0 && (SCM_I_WVECTP (vv)))
 -            {
 -              scm_c_issue_deprecation_warning
 -                ("Weak arrays are deprecated.  Use weak vectors instead.");
 -              /* ELT was a weak pointer and got nullified by the GC.  */
 -              return SCM_BOOL_F;
 -            }
 -
 -        return elt;
 -      }
 -      scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
 -    }
 -  else if (SCM_UNPACK (g_vector_ref))
 -    {
 -      scm_c_issue_deprecation_warning
 -        ("Using vector-ref as a primitive-generic is deprecated.");
 -      return scm_call_generic_2 (g_vector_ref, v, scm_from_size_t (k));
--    }
--  else
--    {
--      scm_wrong_type_arg_msg ("vector-ref", 1, v, "vector");
--      return SCM_UNDEFINED;  /* not reached */
--    }
++  return SCM_SIMPLE_VECTOR_REF (v, k);
  }
++#undef FUNC_NAME
  
 -SCM_GPROC (s_vector_set_x, "vector-set!", 3, 0, 0, scm_vector_set_x, g_vector_set_x);
 -
 -/* "@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"
 -   "The value returned by @samp{vector-set!} is unspecified.\n"
 -   "@lisp\n"
 -   "(let ((vec (vector 0 '(2 2 2 2) "Anna")))\n"
 -   "  (vector-set! vec 1 '("Sue" "Sue"))\n"
 -   "  vec) @result{}  #(0 ("Sue" "Sue") "Anna")\n"
 -   "(vector-set! '#(0 1 2) 1 "doe") @result{} @emph{error} ; constant vector\n"
 -   "@end lisp"
 -*/
 -
 -SCM
 -scm_vector_set_x (SCM v, SCM k, SCM obj)
 -#define FUNC_NAME s_vector_set_x
 +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"
 +            "The value returned by @samp{vector-set!} is unspecified.\n"
 +            "@lisp\n"
 +            "(let ((vec (vector 0 '(2 2 2 2) \"Anna\")))\n"
 +            "  (vector-set! vec 1 '(\"Sue\" \"Sue\"))\n"
 +            "  vec) @result{}  #(0 (\"Sue\" \"Sue\") \"Anna\")\n"
 +            "(vector-set! '#(0 1 2) 1 \"doe\") @result{} @emph{error} ; constant vector\n"
 +            "@end lisp")
 +#define FUNC_NAME s_scm_vector_set_x
  {
 -  scm_c_vector_set_x (v, scm_to_size_t (k), obj);
 +  scm_c_vector_set_x (vector, scm_to_size_t (k), obj);
    return SCM_UNSPECIFIED;
  }
  #undef FUNC_NAME
  
  void
  scm_c_vector_set_x (SCM v, size_t k, SCM obj)
++#define FUNC_NAME s_scm_vector_set_x
  {
--  if (SCM_I_IS_NONWEAK_VECTOR (v))
--    {
--      if (k >= SCM_I_VECTOR_LENGTH (v))
-         scm_out_of_range (NULL, scm_from_size_t (k)); 
-       SCM_SIMPLE_VECTOR_SET (v, k, obj);
 -      scm_out_of_range (NULL, scm_from_size_t (k)); 
 -      (SCM_I_VECTOR_WELTS(v))[k] = obj;
 -    }
 -  else if (SCM_I_WVECTP (v))
 -    {
 -      scm_c_issue_deprecation_warning
 -        ("Using vector-set! on weak vectors is deprecated.  "
 -         "Instead, use weak-vector-set! from (ice-9 weak-vectors).");
 -      scm_c_weak_vector_set_x (v, k, obj);
--    }
--  else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
--    {
--      scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
--      SCM vv = SCM_I_ARRAY_V (v);
 -      if (SCM_I_IS_VECTOR (vv))
 -      {
 -          scm_c_issue_deprecation_warning
 -            ("Using vector-set! on arrays is deprecated.  "
 -             "Use array-set! instead, but note the change in argument order.");
 -
 -        if (k >= dim->ubnd - dim->lbnd + 1)
 -          scm_out_of_range (NULL, scm_from_size_t (k));
 -        k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
 -        (SCM_I_VECTOR_WELTS (vv))[k] = obj;
 -
 -        if (SCM_I_WVECTP (vv))
 -          {
 -            /* Make it a weak pointer.  */
 -            SCM *link = & SCM_I_VECTOR_WELTS (vv)[k];
 -            SCM_I_REGISTER_DISAPPEARING_LINK ((void **) link, SCM2PTR (obj));
 -              scm_c_issue_deprecation_warning
 -                ("Weak arrays are deprecated.  Use weak vectors instead.");
 -          }
 -      }
 -      else
 -      scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
 -    }
 -  else if (SCM_UNPACK (g_vector_set_x))
 -    {
 -      scm_c_issue_deprecation_warning
 -        ("Using vector-set! as a primitive-generic is deprecated.");
 -      scm_call_3 (g_vector_set_x, v, scm_from_size_t (k), obj);
 -    }
 -  else
 -    scm_wrong_type_arg_msg ("vector-set!", 1, v, "vector");
++  SCM_VALIDATE_VECTOR (1, v);
 +
-       k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
-       if (k >= dim->ubnd - dim->lbnd + 1)
-         scm_out_of_range (NULL, scm_from_size_t (k));
++  if (k >= SCM_I_VECTOR_LENGTH (v))
++    scm_out_of_range (NULL, scm_from_size_t (k)); 
 +
-       if (SCM_I_IS_NONWEAK_VECTOR (vv))
-         SCM_SIMPLE_VECTOR_SET (vv, k, obj);
-       else
-       scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
-     }
-   else
-     scm_wrong_type_arg_msg ("vector-set!", 1, v, "vector");
++  SCM_SIMPLE_VECTOR_SET (v, k, obj);
  }
++#undef FUNC_NAME
  
  SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
              (SCM k, SCM fill),