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 #undef FUNC_NAME
SCM_GPROC (s_vector_length, "vector-length", 1, 0, 0, scm_vector_length, g_vector_length); SCM_DEFINE (scm_vector_length, "vector-length", 1, 0, 0,
/* Returns the number of elements in @var{vector} as an exact integer. */ (SCM v),
SCM "Returns the number of elements in @var{vector} as an exact integer.")
scm_vector_length (SCM v) #define FUNC_NAME s_scm_vector_length
{ {
if (SCM_I_IS_NONWEAK_VECTOR (v)) if (SCM_I_IS_NONWEAK_VECTOR (v))
return scm_from_size_t (SCM_I_VECTOR_LENGTH (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); return scm_from_size_t (dim->ubnd - dim->lbnd + 1);
} }
else 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 size_t
scm_c_vector_length (SCM v) scm_c_vector_length (SCM v)
@ -174,27 +178,22 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_GPROC (s_vector_ref, "vector-ref", 2, 0, 0, scm_vector_ref, g_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"
"@var{k} must be a valid index of @var{vector}.\n" "@samp{Vector-ref} returns the contents of element @var{k} of\n"
"@samp{Vector-ref} returns the contents of element @var{k} of\n" "@var{vector}.\n\n"
"@var{vector}.\n\n" "@lisp\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) 5) @result{} 8\n" "(vector-ref '#(1 1 2 3 5 8 13 21)\n"
"(vector-ref '#(1 1 2 3 5 8 13 21)\n" " (let ((i (round (* 2 (acos -1)))))\n"
" (let ((i (round (* 2 (acos -1)))))\n" " (if (inexact? i)\n"
" (if (inexact? i)\n" " (inexact->exact i)\n"
" (inexact->exact i)\n" " i))) @result{} 13\n"
" i))) @result{} 13\n" "@end lisp")
"@end lisp" #define FUNC_NAME s_scm_vector_ref
*/
SCM
scm_vector_ref (SCM v, SCM k)
#define FUNC_NAME s_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 #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"); scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
} }
else 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); 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" "@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" "@code{Vector-set!} stores @var{obj} in element @var{k} of @var{vector}.\n"
"The value returned by @samp{vector-set!} is unspecified.\n" "The value returned by @samp{vector-set!} is unspecified.\n"
"@lisp\n" "@lisp\n"
"(let ((vec (vector 0 '(2 2 2 2) "Anna")))\n" "(let ((vec (vector 0 '(2 2 2 2) \"Anna\")))\n"
" (vector-set! vec 1 '("Sue" "Sue"))\n" " (vector-set! vec 1 '(\"Sue\" \"Sue\"))\n"
" vec) @result{} #(0 ("Sue" "Sue") "Anna")\n" " vec) @result{} #(0 (\"Sue\" \"Sue\") \"Anna\")\n"
"(vector-set! '#(0 1 2) 1 "doe") @result{} @emph{error} ; constant vector\n" "(vector-set! '#(0 1 2) 1 \"doe\") @result{} @emph{error} ; constant vector\n"
"@end lisp" "@end lisp")
*/ #define FUNC_NAME s_scm_vector_set_x
SCM
scm_vector_set_x (SCM v, SCM k, SCM obj)
#define FUNC_NAME s_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; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #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"); scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
} }
else else
{ scm_wrong_type_arg_msg ("vector-set!", 1, v, "vector");
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_DEFINE (scm_make_vector, "make-vector", 1, 1, 0, SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,