Add weak-vector-length, weak-vector-ref, weak-vector-set!

* libguile/weaks.c (scm_is_weak_vector, scm_c_weak_vector_length):
  (scm_c_weak_vector_ref, scm_c_weak_vector_set_x): New interfaces for
  dealing with weak vectors from C.
  (scm_weak_vector_length, scm_weak_vector_ref, scm_weak_vector_set_x):
  New Scheme interfaces to weak vectors; to be used instead of
  vector-length, vector-ref, etc.

* module/ice-9/weak-vector.scm: Export the new interfaces.

* doc/ref/api-memory.texi (Weak vectors): Document them.

doc/ref/api-memory.texi

@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2012
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2012, 2014
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -413,6 +413,17 @@ Return @code{#t} if @var{obj} is a weak vector. Note that all
 weak hashes are also weak vectors.
 @end deffn
 
+@deffn {Scheme Procedure} weak-vector-ref wvect k
+@deffnx {C Function} scm_weak_vector_ref (wvect, k)
+Return the @var{k}th element of the weak vector @var{wvect}, or
+@code{#f} if that element has been collected.
+@end deffn
+
+@deffn {Scheme Procedure} weak-vector-set! wvect k elt
+@deffnx {C Function} scm_weak_vector_set_x (wvect, k, elt)
+Set the @var{k}th element of the weak vector @var{wvect} to @var{elt}.
+@end deffn
+
 
 @node Guardians
 @subsection Guardians

libguile/weaks.c

@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2003, 2006, 2008, 2009, 2010,
- *   2011, 2012 Free Software Foundation, Inc.
+ *   2011, 2012, 2014 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -122,6 +122,10 @@ scm_doubly_weak_pair (SCM car, SCM cdr)
  */
 
 
+#define SCM_VALIDATE_WEAK_VECTOR(pos, var) \
+  SCM_I_MAKE_VALIDATE_MSG2 (pos, var, SCM_I_WVECTP, "weak vector")
+
+
 SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
 	    (SCM size, SCM fill),
 	    "Return a weak vector with @var{size} elements. If the optional\n"
@@ -157,10 +161,101 @@ SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
 	    "weak hashes are also weak vectors.")
 #define FUNC_NAME s_scm_weak_vector_p
 {
-  return scm_from_bool (SCM_I_WVECTP (obj) && !SCM_IS_WHVEC (obj));
+  return scm_from_bool (scm_is_weak_vector (obj));
 }
 #undef FUNC_NAME
 
+
+int
+scm_is_weak_vector (SCM obj)
+{
+  return SCM_I_WVECTP (obj) && !SCM_IS_WHVEC (obj);
+}
+
+
+SCM_DEFINE (scm_weak_vector_length, "weak-vector-length", 1, 0, 0,
+	    (SCM wvect),
+            "Returns the number of elements in @var{wvect} as an exact integer.")
+#define FUNC_NAME s_scm_weak_vector_length
+{
+  return scm_from_size_t (scm_c_weak_vector_length (wvect));
+}
+#undef FUNC_NAME
+
+
+size_t
+scm_c_weak_vector_length (SCM wvect)
+#define FUNC_NAME s_scm_weak_vector_length
+{
+  SCM_VALIDATE_WEAK_VECTOR (1, wvect);
+  return SCM_I_VECTOR_LENGTH (wvect);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_weak_vector_ref, "weak-vector-ref", 2, 0, 0,
+	    (SCM wvect, SCM k),
+            "Like @code{vector-ref}, but for weak vectors.")
+#define FUNC_NAME s_scm_weak_vector_ref
+{
+  return scm_c_weak_vector_ref (wvect, scm_to_size_t (k));
+}
+#undef FUNC_NAME
+
+
+SCM
+scm_c_weak_vector_ref (SCM wvect, size_t k)
+#define FUNC_NAME s_scm_weak_vector_ref
+{
+  SCM elt;
+
+  SCM_VALIDATE_WEAK_VECTOR (1, wvect);
+
+  if (k >= SCM_I_VECTOR_LENGTH (wvect))
+    scm_out_of_range (NULL, scm_from_size_t (k));
+  elt = (SCM_I_VECTOR_ELTS(wvect))[k];
+
+  if (SCM_UNPACK (elt) == 0)
+    /* ELT was a weak pointer and got nullified by the GC.  */
+    return SCM_BOOL_F;
+
+  return elt;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_weak_vector_set_x, "weak-vector-set!", 3, 0, 0,
+	    (SCM wvect, SCM k, SCM elt),
+            "Like @code{vector-set!}, but for weak vectors.")
+#define FUNC_NAME s_scm_weak_vector_set_x
+{
+  scm_c_weak_vector_set_x (wvect, scm_to_size_t (k), elt);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+void
+scm_c_weak_vector_set_x (SCM wvect, size_t k, SCM elt)
+#define FUNC_NAME s_scm_weak_vector_set_x
+{
+  SCM *loc;
+
+  SCM_VALIDATE_WEAK_VECTOR (1, wvect);
+
+  if (k >= SCM_I_VECTOR_LENGTH (wvect))
+    scm_out_of_range (NULL, scm_from_size_t (k));
+
+  loc = & SCM_I_VECTOR_WELTS (wvect)[k];
+  *loc = elt;
+
+  /* Make it a weak pointer.  */
+  SCM_I_REGISTER_DISAPPEARING_LINK ((void **) loc, SCM2PTR (elt));
+}
+#undef FUNC_NAME
+
+
 
 /* Weak alist vectors, i.e., vectors of alists.
 

libguile/weaks.h

@@ -3,7 +3,7 @@
 #ifndef SCM_WEAKS_H
 #define SCM_WEAKS_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009, 2011, 2014 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -76,6 +76,16 @@ SCM_INTERNAL SCM scm_doubly_weak_pair (SCM car, SCM cdr);
 SCM_API SCM scm_make_weak_vector (SCM k, SCM fill);
 SCM_API SCM scm_weak_vector (SCM l);
 SCM_API SCM scm_weak_vector_p (SCM x);
+SCM_API SCM scm_weak_vector_length (SCM v);
+SCM_API SCM scm_weak_vector_ref (SCM v, SCM k);
+SCM_API SCM scm_weak_vector_set_x (SCM v, SCM k, SCM x);
+
+SCM_API SCM scm_c_make_weak_vector (size_t k, SCM fill);
+SCM_API int scm_is_weak_vector (SCM obj);
+SCM_API size_t scm_c_weak_vector_length (SCM vec);
+SCM_API SCM scm_c_weak_vector_ref (SCM v, size_t k);
+SCM_API void scm_c_weak_vector_set_x (SCM v, size_t k, SCM x);
+
 SCM_API SCM scm_make_weak_key_alist_vector (SCM k);
 SCM_API SCM scm_make_weak_value_alist_vector (SCM k);
 SCM_API SCM scm_make_doubly_weak_alist_vector (SCM k);

module/ice-9/weak-vector.scm

@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006, 2014 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -20,6 +20,7 @@
 
 (define-module (ice-9 weak-vector)
   :export (make-weak-vector list->weak-vector weak-vector weak-vector?
+           weak-vector-length weak-vector-ref weak-vector-set!
 	   make-weak-key-alist-vector
 	   make-weak-value-alist-vector
 	   make-doubly-weak-alist-vector