libguile/vectors.c

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