}
#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)
}
#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
{
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
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,