mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Merge commit '5cfeff11cc'

Browse source 
Conflicts:
	libguile/vectors.c
This commit is contained in:
Andy Wingo 2014-02-08 16:54:01 +01:00
commit e0a00fe7e4
1 changed files with 42 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

95
libguile/vectors.c
View file

@ -106,10 +106,10 @@ SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
}
#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));
@ -119,8 +119,12 @@ scm_vector_length (SCM v)
return scm_from_size_t (dim->ubnd - dim->lbnd + 1);
}
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 +178,22 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
}
#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
@ -222,28 +221,26 @@ scm_c_vector_ref (SCM v, size_t k)
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
@ -272,15 +269,7 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
}
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");
}
SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,