Merge commit '5cfeff11cc58148c58a85a879fd7a3e7cfbbe8e2'
authorAndy Wingo <wingo@pobox.com>
Sat, 8 Feb 2014 15:54:01 +0000 (16:54 +0100)
committerAndy Wingo <wingo@pobox.com>
Sat, 8 Feb 2014 15:54:01 +0000 (16:54 +0100)
Conflicts:
libguile/vectors.c

1  2 
libguile/vectors.c

@@@ -106,21 -111,36 +106,25 @@@ 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_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));
 -    }
 +  if (SCM_I_IS_NONWEAK_VECTOR (v))
 +    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);
        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
-     return scm_wta_dispatch_1 (g_vector_length, v, 1, "vector-length");
+     {
+       scm_wrong_type_arg_msg ("vector-length", 1, v, "vector");
+       return SCM_UNDEFINED;  /* not reached */
+     }
  }
++#undef FUNC_NAME
  
  size_t
  scm_c_vector_length (SCM v)
@@@ -174,27 -194,27 +178,22 @@@ SCM_DEFINE (scm_vector, "vector", 0, 0
  }
  #undef FUNC_NAME
  
--SCM_GPROC (s_vector_ref, "vector-ref", 2, 0, 0, scm_vector_ref, g_vector_ref);
--
--/*
--           "@var{k} must be a valid index of @var{vector}.\n"
--         "@samp{Vector-ref} returns the contents of element @var{k} of\n"
--         "@var{vector}.\n\n"
--         "@lisp\n"
--         "(vector-ref '#(1 1 2 3 5 8 13 21) 5) @result{} 8\n"
--         "(vector-ref '#(1 1 2 3 5 8 13 21)\n"
--         "    (let ((i (round (* 2 (acos -1)))))\n"
--         "      (if (inexact? i)\n"
--         "        (inexact->exact i)\n"
--         "           i))) @result{} 13\n"
--         "@end lisp"
--*/
--
--SCM
--scm_vector_ref (SCM v, SCM k)
--#define FUNC_NAME s_vector_ref
++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"
++            "@var{vector}.\n\n"
++            "@lisp\n"
++            "(vector-ref '#(1 1 2 3 5 8 13 21) 5) @result{} 8\n"
++            "(vector-ref '#(1 1 2 3 5 8 13 21)\n"
++            "    (let ((i (round (* 2 (acos -1)))))\n"
++            "      (if (inexact? i)\n"
++            "        (inexact->exact i)\n"
++            "           i))) @result{} 13\n"
++            "@end lisp")
++#define FUNC_NAME s_scm_vector_ref
  {
--  return scm_c_vector_ref (v, scm_to_size_t (k));
++  return scm_c_vector_ref (vector, scm_to_size_t (k));
  }
  #undef FUNC_NAME
  
@@@ -211,39 -242,58 +210,37 @@@ scm_c_vector_ref (SCM v, size_t k
      {
        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;
 -
 -        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));
 +
 +      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 (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");
      }
    else
-     return scm_wta_dispatch_2 (g_vector_ref, v, scm_from_size_t (k), 2,
-                                "vector-ref");
+     {
+       scm_wrong_type_arg_msg ("vector-ref", 1, v, "vector");
+       return SCM_UNDEFINED;  /* not reached */
+     }
  }
  
--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
@@@ -271,16 -337,17 +268,8 @@@ scm_c_vector_set_x (SCM v, size_t k, SC
        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.");
 -      return scm_call_3 (g_vector_set_x, v, scm_from_size_t (k), obj);
 -    }
    else
--    {
-       if (SCM_UNPACK (g_vector_set_x))
-       scm_wta_dispatch_n (g_vector_set_x,
-                             scm_list_3 (v, scm_from_size_t (k), obj),
-                             0,
-                             "vector-set!");
-       else
-       scm_wrong_type_arg_msg (NULL, 0, v, "vector");
 -      scm_wrong_type_arg_msg ("vector-set!", 1, v, "vector");
 -      return SCM_UNDEFINED;  /* not reached */
--    }
++    scm_wrong_type_arg_msg ("vector-set!", 1, v, "vector");
  }
  
  SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,