1 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2010 Free Software Foundation, Inc.
2 *
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
7 *
8 * This library is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
12 *
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
16 */
17
18
19
20 #ifdef HAVE_CONFIG_H
21 # include <config.h>
22 #endif
23
24 #include "libguile/_scm.h"
25 #include "libguile/eq.h"
26 #include "libguile/root.h"
27 #include "libguile/strings.h"
28 #include "libguile/lang.h"
29
30 #include "libguile/validate.h"
31 #include "libguile/vectors.h"
32 #include "libguile/unif.h"
33 #include "libguile/ramap.h"
34 #include "libguile/srfi-4.h"
35 #include "libguile/strings.h"
36 #include "libguile/srfi-13.h"
37 #include "libguile/dynwind.h"
38 #include "libguile/deprecation.h"
39
40
41
42 #define VECTOR_MAX_LENGTH (SCM_T_BITS_MAX >> 8)
43
44 int
scm_is_vector(SCM obj)45 scm_is_vector (SCM obj)
46 {
47 if (SCM_I_IS_VECTOR (obj))
48 return 1;
49 if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
50 {
51 SCM v = SCM_I_ARRAY_V (obj);
52 return SCM_I_IS_VECTOR (v);
53 }
54 return 0;
55 }
56
57 int
scm_is_simple_vector(SCM obj)58 scm_is_simple_vector (SCM obj)
59 {
60 return SCM_I_IS_VECTOR (obj);
61 }
62
63 const SCM *
scm_vector_elements(SCM vec,scm_t_array_handle * h,size_t * lenp,ssize_t * incp)64 scm_vector_elements (SCM vec, scm_t_array_handle *h,
65 size_t *lenp, ssize_t *incp)
66 {
67 scm_generalized_vector_get_handle (vec, h);
68 if (lenp)
69 {
70 scm_t_array_dim *dim = scm_array_handle_dims (h);
71 *lenp = dim->ubnd - dim->lbnd + 1;
72 *incp = dim->inc;
73 }
74 return scm_array_handle_elements (h);
75 }
76
77 SCM *
scm_vector_writable_elements(SCM vec,scm_t_array_handle * h,size_t * lenp,ssize_t * incp)78 scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
79 size_t *lenp, ssize_t *incp)
80 {
81 scm_generalized_vector_get_handle (vec, h);
82 if (lenp)
83 {
84 scm_t_array_dim *dim = scm_array_handle_dims (h);
85 *lenp = dim->ubnd - dim->lbnd + 1;
86 *incp = dim->inc;
87 }
88 return scm_array_handle_writable_elements (h);
89 }
90
91 SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
92 (SCM obj),
93 "Return @code{#t} if @var{obj} is a vector, otherwise return\n"
94 "@code{#f}.")
95 #define FUNC_NAME s_scm_vector_p
96 {
97 return scm_from_bool (scm_is_vector (obj));
98 }
99 #undef FUNC_NAME
100
101 SCM_GPROC (s_vector_length, "vector-length", 1, 0, 0, scm_vector_length, g_vector_length);
102 /* Returns the number of elements in @var{vector} as an exact integer. */
103 SCM
scm_vector_length(SCM v)104 scm_vector_length (SCM v)
105 {
106 if (SCM_I_IS_VECTOR (v))
107 return scm_from_size_t (SCM_I_VECTOR_LENGTH (v));
108 else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
109 {
110 scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
111 return scm_from_size_t (dim->ubnd - dim->lbnd + 1);
112 }
113 else
114 SCM_WTA_DISPATCH_1 (g_vector_length, v, 1, NULL);
115 }
116
117 size_t
scm_c_vector_length(SCM v)118 scm_c_vector_length (SCM v)
119 {
120 if (SCM_I_IS_VECTOR (v))
121 return SCM_I_VECTOR_LENGTH (v);
122 else
123 return scm_to_size_t (scm_vector_length (v));
124 }
125
126 SCM_REGISTER_PROC (s_list_to_vector, "list->vector", 1, 0, 0, scm_vector);
127 /*
128 "Return a newly created vector initialized to the elements of"
129 "the list @var{list}.\n\n"
130 "@lisp\n"
131 "(vector->list '#(dah dah didah)) @result{} (dah dah didah)\n"
132 "(list->vector '(dididit dah)) @result{} #(dididit dah)\n"
133 "@end lisp")
134 */
135 SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
136 (SCM l),
137 "@deffnx {Scheme Procedure} list->vector l\n"
138 "Return a newly allocated vector composed of the\n"
139 "given arguments. Analogous to @code{list}.\n"
140 "\n"
141 "@lisp\n"
142 "(vector 'a 'b 'c) @result{} #(a b c)\n"
143 "@end lisp")
144 #define FUNC_NAME s_scm_vector
145 {
146 SCM res;
147 SCM *data;
148 long i, len;
149 scm_t_array_handle handle;
150
151 SCM_VALIDATE_LIST_COPYLEN (1, l, len);
152
153 res = scm_c_make_vector (len, SCM_UNSPECIFIED);
154 data = scm_vector_writable_elements (res, &handle, NULL, NULL);
155 i = 0;
156 while (scm_is_pair (l) && i < len)
157 {
158 data[i] = SCM_CAR (l);
159 l = SCM_CDR (l);
160 i += 1;
161 }
162
163 scm_array_handle_release (&handle);
164
165 return res;
166 }
167 #undef FUNC_NAME
168
169 SCM_GPROC (s_vector_ref, "vector-ref", 2, 0, 0, scm_vector_ref, g_vector_ref);
170
171 /*
172 "@var{k} must be a valid index of @var{vector}.\n"
173 "@samp{Vector-ref} returns the contents of element @var{k} of\n"
174 "@var{vector}.\n\n"
175 "@lisp\n"
176 "(vector-ref '#(1 1 2 3 5 8 13 21) 5) @result{} 8\n"
177 "(vector-ref '#(1 1 2 3 5 8 13 21)\n"
178 " (let ((i (round (* 2 (acos -1)))))\n"
179 " (if (inexact? i)\n"
180 " (inexact->exact i)\n"
181 " i))) @result{} 13\n"
182 "@end lisp"
183 */
184
185 SCM
scm_vector_ref(SCM v,SCM k)186 scm_vector_ref (SCM v, SCM k)
187 #define FUNC_NAME s_vector_ref
188 {
189 return scm_c_vector_ref (v, scm_to_size_t (k));
190 }
191 #undef FUNC_NAME
192
193 SCM
scm_c_vector_ref(SCM v,size_t k)194 scm_c_vector_ref (SCM v, size_t k)
195 {
196 if (SCM_I_IS_VECTOR (v))
197 {
198 if (k >= SCM_I_VECTOR_LENGTH (v))
199 scm_out_of_range (NULL, scm_from_size_t (k));
200 return (SCM_I_VECTOR_ELTS(v))[k];
201 }
202 else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
203 {
204 scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
205 SCM vv = SCM_I_ARRAY_V (v);
206 if (SCM_I_IS_VECTOR (vv))
207 {
208 if (k >= dim->ubnd - dim->lbnd + 1)
209 scm_out_of_range (NULL, scm_from_size_t (k));
210 k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
211 return (SCM_I_VECTOR_ELTS (vv))[k];
212 }
213 scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
214 }
215 else
216 SCM_WTA_DISPATCH_2 (g_vector_ref, v, scm_from_size_t (k), 2, NULL);
217 }
218
219 SCM_GPROC (s_vector_set_x, "vector-set!", 3, 0, 0, scm_vector_set_x, g_vector_set_x);
220
221 /* "@var{k} must be a valid index of @var{vector}.\n"
222 "@code{Vector-set!} stores @var{obj} in element @var{k} of @var{vector}.\n"
223 "The value returned by @samp{vector-set!} is unspecified.\n"
224 "@lisp\n"
225 "(let ((vec (vector 0 '(2 2 2 2) "Anna")))\n"
226 " (vector-set! vec 1 '("Sue" "Sue"))\n"
227 " vec) @result{} #(0 ("Sue" "Sue") "Anna")\n"
228 "(vector-set! '#(0 1 2) 1 "doe") @result{} @emph{error} ; constant vector\n"
229 "@end lisp"
230 */
231
232 SCM
scm_vector_set_x(SCM v,SCM k,SCM obj)233 scm_vector_set_x (SCM v, SCM k, SCM obj)
234 #define FUNC_NAME s_vector_set_x
235 {
236 scm_c_vector_set_x (v, scm_to_size_t (k), obj);
237 return SCM_UNSPECIFIED;
238 }
239 #undef FUNC_NAME
240
241 void
scm_c_vector_set_x(SCM v,size_t k,SCM obj)242 scm_c_vector_set_x (SCM v, size_t k, SCM obj)
243 {
244 if (SCM_I_IS_VECTOR (v))
245 {
246 if (k >= SCM_I_VECTOR_LENGTH (v))
247 scm_out_of_range (NULL, scm_from_size_t (k));
248 (SCM_I_VECTOR_WELTS(v))[k] = obj;
249 }
250 else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
251 {
252 scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
253 SCM vv = SCM_I_ARRAY_V (v);
254 if (SCM_I_IS_VECTOR (vv))
255 {
256 if (k >= dim->ubnd - dim->lbnd + 1)
257 scm_out_of_range (NULL, scm_from_size_t (k));
258 k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
259 (SCM_I_VECTOR_WELTS (vv))[k] = obj;
260 }
261 else
262 scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
263 }
264 else
265 {
266 if (SCM_UNPACK (g_vector_set_x))
267 scm_apply_generic (g_vector_set_x,
268 scm_list_3 (v, scm_from_size_t (k), obj));
269 else
270 scm_wrong_type_arg_msg (NULL, 0, v, "vector");
271 }
272 }
273
274 SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
275 (SCM k, SCM fill),
276 "Return a newly allocated vector of @var{k} elements. If a\n"
277 "second argument is given, then each position is initialized to\n"
278 "@var{fill}. Otherwise the initial contents of each position is\n"
279 "unspecified.")
280 #define FUNC_NAME s_scm_make_vector
281 {
282 size_t l = scm_to_unsigned_integer (k, 0, VECTOR_MAX_LENGTH);
283
284 if (SCM_UNBNDP (fill))
285 fill = SCM_UNSPECIFIED;
286
287 return scm_c_make_vector (l, fill);
288 }
289 #undef FUNC_NAME
290
291
292 SCM
scm_c_make_vector(size_t k,SCM fill)293 scm_c_make_vector (size_t k, SCM fill)
294 #define FUNC_NAME s_scm_make_vector
295 {
296 SCM v;
297 SCM *base;
298
299 if (k > 0)
300 {
301 unsigned long int j;
302
303 SCM_ASSERT_RANGE (1, scm_from_ulong (k), k <= VECTOR_MAX_LENGTH);
304
305 base = scm_gc_malloc (k * sizeof (SCM), "vector");
306 for (j = 0; j != k; ++j)
307 base[j] = fill;
308 }
309 else
310 base = NULL;
311
312 v = scm_cell ((k << 8) | scm_tc7_vector, (scm_t_bits) base);
313 scm_remember_upto_here_1 (fill);
314
315 return v;
316 }
317 #undef FUNC_NAME
318
319 SCM_DEFINE (scm_vector_copy, "vector-copy", 1, 0, 0,
320 (SCM vec),
321 "Return a copy of @var{vec}.")
322 #define FUNC_NAME s_scm_vector_copy
323 {
324 scm_t_array_handle handle;
325 size_t i, len;
326 ssize_t inc;
327 const SCM *src;
328 SCM *dst;
329
330 src = scm_vector_elements (vec, &handle, &len, &inc);
331 dst = scm_gc_malloc (len * sizeof (SCM), "vector");
332 for (i = 0; i < len; i++, src += inc)
333 dst[i] = *src;
334 scm_array_handle_release (&handle);
335
336 return scm_cell ((len << 8) | scm_tc7_vector, (scm_t_bits) dst);
337 }
338 #undef FUNC_NAME
339
340 void
scm_i_vector_free(SCM vec)341 scm_i_vector_free (SCM vec)
342 {
343 scm_gc_free (SCM_I_VECTOR_WELTS (vec),
344 SCM_I_VECTOR_LENGTH (vec) * sizeof(SCM),
345 "vector");
346 }
347
348 /* Allocate memory for a weak vector on behalf of the caller. The allocated
349 * vector will be of the given weak vector subtype. It will contain size
350 * elements which are initialized with the 'fill' object, or, if 'fill' is
351 * undefined, with an unspecified object.
352 */
353 SCM
scm_i_allocate_weak_vector(scm_t_bits type,SCM size,SCM fill)354 scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM fill)
355 {
356 size_t c_size;
357 SCM *base;
358 SCM v;
359
360 c_size = scm_to_unsigned_integer (size, 0, VECTOR_MAX_LENGTH);
361
362 if (c_size > 0)
363 {
364 size_t j;
365
366 if (SCM_UNBNDP (fill))
367 fill = SCM_UNSPECIFIED;
368
369 base = scm_gc_malloc (c_size * sizeof (SCM), "weak vector");
370 for (j = 0; j != c_size; ++j)
371 base[j] = fill;
372 }
373 else
374 base = NULL;
375
376 v = scm_double_cell ((c_size << 8) | scm_tc7_wvect,
377 (scm_t_bits) base,
378 type,
379 SCM_UNPACK (SCM_EOL));
380 scm_remember_upto_here_1 (fill);
381
382 return v;
383 }
384
385 SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
386 (SCM v),
387 "Return a newly allocated list composed of the elements of @var{v}.\n"
388 "\n"
389 "@lisp\n"
390 "(vector->list '#(dah dah didah)) @result{} (dah dah didah)\n"
391 "(list->vector '(dididit dah)) @result{} #(dididit dah)\n"
392 "@end lisp")
393 #define FUNC_NAME s_scm_vector_to_list
394 {
395 SCM res = SCM_EOL;
396 const SCM *data;
397 scm_t_array_handle handle;
398 size_t i, count, len;
399 ssize_t inc;
400
401 data = scm_vector_elements (v, &handle, &len, &inc);
402 for (i = (len - 1) * inc, count = 0;
403 count < len;
404 i -= inc, count++)
405 res = scm_cons (data[i], res);
406
407 scm_array_handle_release (&handle);
408 return res;
409 }
410 #undef FUNC_NAME
411
412
413 SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0,
414 (SCM v, SCM fill),
415 "Store @var{fill} in every position of @var{vector}. The value\n"
416 "returned by @code{vector-fill!} is unspecified.")
417 #define FUNC_NAME s_scm_vector_fill_x
418 {
419 scm_t_array_handle handle;
420 SCM *data;
421 size_t i, len;
422 ssize_t inc;
423
424 data = scm_vector_writable_elements (v, &handle, &len, &inc);
425 for (i = 0; i < len; i += inc)
426 data[i] = fill;
427 scm_array_handle_release (&handle);
428 return SCM_UNSPECIFIED;
429 }
430 #undef FUNC_NAME
431
432
433 SCM
scm_i_vector_equal_p(SCM x,SCM y)434 scm_i_vector_equal_p (SCM x, SCM y)
435 {
436 long i;
437 for (i = SCM_I_VECTOR_LENGTH (x) - 1; i >= 0; i--)
438 if (scm_is_false (scm_equal_p (SCM_I_VECTOR_ELTS (x)[i],
439 SCM_I_VECTOR_ELTS (y)[i])))
440 return SCM_BOOL_F;
441 return SCM_BOOL_T;
442 }
443
444
445 SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
446 (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2),
447 "Copy elements from @var{vec1}, positions @var{start1} to @var{end1},\n"
448 "to @var{vec2} starting at position @var{start2}. @var{start1} and\n"
449 "@var{start2} are inclusive indices; @var{end1} is exclusive.\n\n"
450 "@code{vector-move-left!} copies elements in leftmost order.\n"
451 "Therefore, in the case where @var{vec1} and @var{vec2} refer to the\n"
452 "same vector, @code{vector-move-left!} is usually appropriate when\n"
453 "@var{start1} is greater than @var{start2}.")
454 #define FUNC_NAME s_scm_vector_move_left_x
455 {
456 scm_t_array_handle handle1, handle2;
457 const SCM *elts1;
458 SCM *elts2;
459 size_t len1, len2;
460 ssize_t inc1, inc2;
461 size_t i, j, e;
462
463 elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
464 elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
465
466 i = scm_to_unsigned_integer (start1, 0, len1);
467 e = scm_to_unsigned_integer (end1, i, len1);
468 SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) < len2);
469 j = scm_to_unsigned_integer (start2, 0, len2);
470 SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
471
472 i *= inc1;
473 e *= inc1;
474 j *= inc2;
475 for (; i < e; i += inc1, j += inc2)
476 elts2[j] = elts1[i];
477
478 scm_array_handle_release (&handle2);
479 scm_array_handle_release (&handle1);
480
481 return SCM_UNSPECIFIED;
482 }
483 #undef FUNC_NAME
484
485 SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
486 (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2),
487 "Copy elements from @var{vec1}, positions @var{start1} to @var{end1},\n"
488 "to @var{vec2} starting at position @var{start2}. @var{start1} and\n"
489 "@var{start2} are inclusive indices; @var{end1} is exclusive.\n\n"
490 "@code{vector-move-right!} copies elements in rightmost order.\n"
491 "Therefore, in the case where @var{vec1} and @var{vec2} refer to the\n"
492 "same vector, @code{vector-move-right!} is usually appropriate when\n"
493 "@var{start1} is less than @var{start2}.")
494 #define FUNC_NAME s_scm_vector_move_right_x
495 {
496 scm_t_array_handle handle1, handle2;
497 const SCM *elts1;
498 SCM *elts2;
499 size_t len1, len2;
500 ssize_t inc1, inc2;
501 size_t i, j, e;
502
503 elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
504 elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
505
506 i = scm_to_unsigned_integer (start1, 0, len1);
507 e = scm_to_unsigned_integer (end1, i, len1);
508 SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) < len2);
509 j = scm_to_unsigned_integer (start2, 0, len2);
510 SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
511
512 j += (e - i);
513
514 i *= inc1;
515 e *= inc1;
516 j *= inc2;
517 while (i < e)
518 {
519 e -= inc1;
520 j -= inc2;
521 elts2[j] = elts1[e];
522 }
523
524 scm_array_handle_release (&handle2);
525 scm_array_handle_release (&handle1);
526
527 return SCM_UNSPECIFIED;
528 }
529 #undef FUNC_NAME
530
531
532 /* Generalized vectors. */
533
534 int
scm_is_generalized_vector(SCM obj)535 scm_is_generalized_vector (SCM obj)
536 {
537 return (scm_is_vector (obj)
538 || scm_is_string (obj)
539 || scm_is_bitvector (obj)
540 || scm_is_uniform_vector (obj));
541 }
542
543 SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
544 (SCM obj),
545 "Return @code{#t} if @var{obj} is a vector, string,\n"
546 "bitvector, or uniform numeric vector.")
547 #define FUNC_NAME s_scm_generalized_vector_p
548 {
549 return scm_from_bool (scm_is_generalized_vector (obj));
550 }
551 #undef FUNC_NAME
552
553 void
scm_generalized_vector_get_handle(SCM vec,scm_t_array_handle * h)554 scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
555 {
556 scm_array_get_handle (vec, h);
557 if (scm_array_handle_rank (h) != 1)
558 scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
559 }
560
561 size_t
scm_c_generalized_vector_length(SCM v)562 scm_c_generalized_vector_length (SCM v)
563 {
564 if (scm_is_vector (v))
565 return scm_c_vector_length (v);
566 else if (scm_is_string (v))
567 return scm_c_string_length (v);
568 else if (scm_is_bitvector (v))
569 return scm_c_bitvector_length (v);
570 else if (scm_is_uniform_vector (v))
571 return scm_c_uniform_vector_length (v);
572 else
573 scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
574 }
575
576 SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0,
577 (SCM v),
578 "Return the length of the generalized vector @var{v}.")
579 #define FUNC_NAME s_scm_generalized_vector_length
580 {
581 return scm_from_size_t (scm_c_generalized_vector_length (v));
582 }
583 #undef FUNC_NAME
584
585 SCM
scm_c_generalized_vector_ref(SCM v,size_t idx)586 scm_c_generalized_vector_ref (SCM v, size_t idx)
587 {
588 if (scm_is_vector (v))
589 return scm_c_vector_ref (v, idx);
590 else if (scm_is_string (v))
591 return scm_c_string_ref (v, idx);
592 else if (scm_is_bitvector (v))
593 return scm_c_bitvector_ref (v, idx);
594 else if (scm_is_uniform_vector (v))
595 return scm_c_uniform_vector_ref (v, idx);
596 else
597 scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
598 }
599
600 SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
601 (SCM v, SCM idx),
602 "Return the element at index @var{idx} of the\n"
603 "generalized vector @var{v}.")
604 #define FUNC_NAME s_scm_generalized_vector_ref
605 {
606 return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
607 }
608 #undef FUNC_NAME
609
610 void
scm_c_generalized_vector_set_x(SCM v,size_t idx,SCM val)611 scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
612 {
613 if (scm_is_vector (v))
614 scm_c_vector_set_x (v, idx, val);
615 else if (scm_is_string (v))
616 scm_c_string_set_x (v, idx, val);
617 else if (scm_is_bitvector (v))
618 scm_c_bitvector_set_x (v, idx, val);
619 else if (scm_is_uniform_vector (v))
620 scm_c_uniform_vector_set_x (v, idx, val);
621 else
622 scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
623 }
624
625 SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
626 (SCM v, SCM idx, SCM val),
627 "Set the element at index @var{idx} of the\n"
628 "generalized vector @var{v} to @var{val}.")
629 #define FUNC_NAME s_scm_generalized_vector_set_x
630 {
631 scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
632 return SCM_UNSPECIFIED;
633 }
634 #undef FUNC_NAME
635
636 SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0,
637 (SCM v),
638 "Return a new list whose elements are the elements of the\n"
639 "generalized vector @var{v}.")
640 #define FUNC_NAME s_scm_generalized_vector_to_list
641 {
642 if (scm_is_vector (v))
643 return scm_vector_to_list (v);
644 else if (scm_is_string (v))
645 return scm_string_to_list (v);
646 else if (scm_is_bitvector (v))
647 return scm_bitvector_to_list (v);
648 else if (scm_is_uniform_vector (v))
649 return scm_uniform_vector_to_list (v);
650 else
651 scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
652 }
653 #undef FUNC_NAME
654
655
656 void
scm_init_vectors()657 scm_init_vectors ()
658 {
659 scm_nullvect = scm_c_make_vector (0, SCM_UNDEFINED);
660
661 #include "libguile/vectors.x"
662 }
663
664
665 /*
666 Local Variables:
667 c-file-style: "gnu"
668 End:
669 */
670