This is an automated email from the git hooks/post-receive script.
wingo pushed a commit to branch wip-whippet
in repository guile.
The following commit(s) were added to refs/heads/wip-whippet by this push:
new c63f9101f Reimplement weak vectors in Scheme using ephemerons
c63f9101f is described below
commit c63f9101f8e6e02a1f034e202d8caa50183992d2
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Mon May 5 16:07:30 2025 +0200
Reimplement weak vectors in Scheme using ephemerons
* module/ice-9/weak-vector.scm: New implementation, same interface.
* doc/ref/api-memory.texi (Weak vectors): Default weak vector value was
documented as empty list when it was actually unspecified, but #f is
most useful, so we change documentation and code to match.
* libguile/Makefile.am (libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES):
(DOT_X_FILES):
(DOT_DOC_FILES):
(noinst_HEADERS):
(modinclude_HEADERS):
* libguile.h:
* libguile/deprecated.c:
* libguile/deprecated.h:
* libguile/init.c:
* libguile/weak-vector.c:
* libguile/weak-vector.h: Remove C weak vector implementation, replaced
with deprecation stubs that call out to Scheme.
* libguile/weak-set.c:
* libguile/weak-table.c:
* libguile/weak-list.h: Remove unused internal header.
* libguile/eq.c:
* libguile/evalext.c:
* libguile/goops.c:
* libguile/hash.c:
* libguile/scm.h:
* module/system/base/types.scm:
* module/system/base/types/internal.scm:
* module/system/vm/assembler.scm: Remove wvect tc7.
---
doc/ref/api-memory.texi | 7 +-
libguile.h | 1 -
libguile/Makefile.am | 13 +-
libguile/deprecated.c | 111 ++++++++++++++
libguile/deprecated.h | 16 ++
libguile/eq.c | 3 +-
libguile/evalext.c | 1 -
libguile/goops.c | 1 -
libguile/hash.c | 3 +-
libguile/init.c | 2 -
libguile/print.c | 20 +--
libguile/scm.h | 2 +-
libguile/weak-list.h | 66 --------
libguile/weak-set.c | 2 -
libguile/weak-table.c | 1 -
libguile/weak-vector.c | 273 ----------------------------------
libguile/weak-vector.h | 48 ------
module/ice-9/weak-vector.scm | 59 +++++++-
module/system/base/types.scm | 2 -
module/system/base/types/internal.scm | 3 +-
module/system/vm/assembler.scm | 1 -
test-suite/tests/types.test | 2 -
22 files changed, 199 insertions(+), 438 deletions(-)
diff --git a/doc/ref/api-memory.texi b/doc/ref/api-memory.texi
index 6d9d5dc39..ddfe3d9db 100644
--- a/doc/ref/api-memory.texi
+++ b/doc/ref/api-memory.texi
@@ -316,10 +316,9 @@ nor a weak value hash table.
@deffn {Scheme Procedure} make-weak-vector size [fill]
@deffnx {C Function} scm_make_weak_vector (size, fill)
-Return a weak vector with @var{size} elements. If the optional
-argument @var{fill} is given, all entries in the vector will be
-set to @var{fill}. The default value for @var{fill} is the
-empty list.
+Return a weak vector with @var{size} elements. If the optional argument
+@var{fill} is given, all entries in the vector will be set to
+@var{fill}. The default value for @var{fill} is @code{#f}.
@end deffn
@deffn {Scheme Procedure} weak-vector elem @dots{}
diff --git a/libguile.h b/libguile.h
index 75554c0c1..6f152fef0 100644
--- a/libguile.h
+++ b/libguile.h
@@ -117,7 +117,6 @@ extern "C" {
#include "libguile/vports.h"
#include "libguile/weak-set.h"
#include "libguile/weak-table.h"
-#include "libguile/weak-vector.h"
#include "libguile/backtrace.h"
#include "libguile/debug.h"
#include "libguile/stacks.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 5ea566da2..f51c6be81 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -240,8 +240,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =
\
vm.c \
vports.c \
weak-set.c \
- weak-table.c \
- weak-vector.c
+ weak-table.c
if ENABLE_JIT
libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES += $(lightening_c_files)
@@ -353,8 +352,7 @@ DOT_X_FILES = \
version.x \
vm.x \
weak-set.x \
- weak-table.x \
- weak-vector.x
+ weak-table.x
EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
@@ -454,8 +452,7 @@ DOT_DOC_FILES = \
version.doc \
vports.doc \
weak-set.doc \
- weak-table.doc \
- weak-vector.doc
+ weak-table.doc
EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
@@ -547,7 +544,6 @@ noinst_HEADERS = custom-ports.h
\
ports-internal.h \
syntax.h \
trace.h \
- weak-list.h \
whippet-embedder.h
# vm instructions
@@ -719,8 +715,7 @@ modinclude_HEADERS = \
vm.h \
vports.h \
weak-set.h \
- weak-table.h \
- weak-vector.h
+ weak-table.h
nodist_modinclude_HEADERS = version.h scmconfig.h
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index c3ba0a9eb..73720a5b8 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -27,6 +27,7 @@
#include "eval.h"
#include "gsubr.h"
#include "modules.h"
+#include "numbers.h"
#include "threads.h"
#include "variable.h"
@@ -60,6 +61,116 @@ scm_make_guardian (void)
+static SCM make_weak_vector_var;
+static SCM weak_vector_var;
+static SCM weak_vector_p_var;
+static SCM weak_vector_length_var;
+static SCM weak_vector_ref_var;
+static SCM weak_vector_set_x_var;
+
+static void
+init_weak_vector_vars (void)
+{
+ make_weak_vector_var =
+ scm_c_public_lookup ("ice-9 weak-vector", "make-weak-vector");
+ weak_vector_var =
+ scm_c_public_lookup ("ice-9 weak-vector", "weak-vector");
+ weak_vector_p_var =
+ scm_c_public_lookup ("ice-9 weak-vector", "weak-vector?");
+ weak_vector_length_var =
+ scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-length");
+ weak_vector_ref_var =
+ scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-ref");
+ weak_vector_set_x_var =
+ scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-set!");
+}
+
+static void
+init_weak_vectors (void)
+{
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_c_issue_deprecation_warning
+ ("The weak vector C interface is deprecated. Invoke the Scheme "
+ "procedures from (ice-9 weak-vector) instead.");
+ scm_i_pthread_once (&once, init_weak_vector_vars);
+}
+
+SCM
+scm_make_weak_vector (SCM len, SCM fill)
+{
+ init_weak_vectors ();
+ return scm_call_2 (scm_variable_ref (make_weak_vector_var), len,
+ SCM_UNBNDP (fill) ? SCM_BOOL_F : fill);
+}
+
+SCM
+scm_weak_vector (SCM l)
+{
+ init_weak_vectors ();
+ return scm_call_1 (scm_variable_ref (weak_vector_var), l);
+}
+
+SCM
+scm_weak_vector_p (SCM x)
+{
+ init_weak_vectors ();
+ return scm_call_1 (scm_variable_ref (weak_vector_p_var), x);
+}
+
+SCM
+scm_weak_vector_length (SCM v)
+{
+ init_weak_vectors ();
+ return scm_call_1 (scm_variable_ref (weak_vector_length_var), v);
+}
+
+SCM
+scm_weak_vector_ref (SCM v, SCM k)
+{
+ init_weak_vectors ();
+ return scm_call_2 (scm_variable_ref (weak_vector_ref_var), v, k);
+}
+
+SCM
+scm_weak_vector_set_x (SCM v, SCM k, SCM x)
+{
+ init_weak_vectors ();
+ scm_call_3 (scm_variable_ref (weak_vector_set_x_var), v, k, x);
+ return SCM_UNSPECIFIED;
+}
+
+SCM
+scm_c_make_weak_vector (size_t len, SCM fill)
+{
+ return scm_make_weak_vector (scm_from_size_t (len), fill);
+}
+
+int
+scm_is_weak_vector (SCM obj)
+{
+ return scm_is_true (scm_weak_vector_p (obj));
+}
+
+size_t
+scm_c_weak_vector_length (SCM vec)
+{
+ return scm_to_size_t (scm_weak_vector_length (vec));
+}
+
+SCM
+scm_c_weak_vector_ref (SCM v, size_t k)
+{
+ return scm_weak_vector_ref (v, scm_from_size_t (k));
+}
+
+void
+scm_c_weak_vector_set_x (SCM v, size_t k, SCM x)
+{
+ scm_weak_vector_set_x (v, scm_from_size_t (k), x);
+}
+
+
+
void
scm_i_init_deprecated ()
{
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index dbe2e4ce2..e7c63d47c 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -25,6 +25,22 @@
#if (SCM_ENABLE_DEPRECATED == 1)
SCM_DEPRECATED SCM scm_make_guardian (void);
+
+#define SCM_I_WVECTP(x) (scm_is_weak_vector (x))
+
+SCM_DEPRECATED SCM scm_make_weak_vector (SCM len, SCM fill);
+SCM_DEPRECATED SCM scm_weak_vector (SCM l);
+SCM_DEPRECATED SCM scm_weak_vector_p (SCM x);
+SCM_DEPRECATED SCM scm_weak_vector_length (SCM v);
+SCM_DEPRECATED SCM scm_weak_vector_ref (SCM v, SCM k);
+SCM_DEPRECATED SCM scm_weak_vector_set_x (SCM v, SCM k, SCM x);
+
+SCM_DEPRECATED SCM scm_c_make_weak_vector (size_t len, SCM fill);
+SCM_DEPRECATED int scm_is_weak_vector (SCM obj);
+SCM_DEPRECATED size_t scm_c_weak_vector_length (SCM vec);
+SCM_DEPRECATED SCM scm_c_weak_vector_ref (SCM v, size_t k);
+SCM_DEPRECATED void scm_c_weak_vector_set_x (SCM v, size_t k, SCM x);
+
/* Deprecated declarations go here. */
void scm_i_init_deprecated (void);
diff --git a/libguile/eq.c b/libguile/eq.c
index 6870613c1..d4d51a05e 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1998,2000-2001,2003-2004,2006,2009-2011,2017-2018,2022
+/* Copyright 1995-1998,2000-2001,2003-2004,2006,2009-2011,2017-2018,2022,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -371,7 +371,6 @@ scm_equal_p (SCM x, SCM y)
case scm_tc7_bitvector:
return scm_i_bitvector_equal_p (x, y);
case scm_tc7_vector:
- case scm_tc7_wvect:
return scm_i_vector_equal_p (x, y);
case scm_tc7_syntax:
if (scm_is_false (scm_equal_p (scm_syntax_wrap (x),
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 3d92cf10d..779d93c1d 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -77,7 +77,6 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0,
0,
switch (SCM_TYP7 (obj))
{
case scm_tc7_vector:
- case scm_tc7_wvect:
case scm_tc7_pointer:
case scm_tc7_hashtable:
case scm_tc7_weak_set:
diff --git a/libguile/goops.c b/libguile/goops.c
index d5770bc99..2f1dc7e5c 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -230,7 +230,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
case scm_tc7_symbol:
return class_symbol;
case scm_tc7_vector:
- case scm_tc7_wvect:
return class_vector;
case scm_tc7_pointer:
return class_foreign;
diff --git a/libguile/hash.c b/libguile/hash.c
index b7ad03309..a076213a2 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1997,2000-2001,2003-2004,2006,2008-2015,2017-2018,2020,2023
+/* Copyright
1995-1997,2000-2001,2003-2004,2006,2008-2015,2017-2018,2020,2023,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -317,7 +317,6 @@ scm_raw_ihash (SCM obj, size_t depth)
return SCM_I_KEYWORD_HASH (obj);
case scm_tc7_pointer:
return scm_raw_ihashq ((uintptr_t) SCM_POINTER_VALUE (obj));
- case scm_tc7_wvect:
case scm_tc7_vector:
{
size_t len = SCM_SIMPLE_VECTOR_LENGTH (obj);
diff --git a/libguile/init.c b/libguile/init.c
index 049e18f9a..6ac140f0e 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -149,7 +149,6 @@
#include "vm.h"
#include "weak-set.h"
#include "weak-table.h"
-#include "weak-vector.h"
#include "init.h"
@@ -460,7 +459,6 @@ scm_i_init_guile (struct gc_stack_addr base)
scm_init_version ();
scm_init_weak_set ();
scm_init_weak_table ();
- scm_init_weak_vectors ();
scm_init_standard_ports (); /* Requires fports */
scm_init_expand (); /* Requires structs */
scm_init_memoize (); /* Requires smob_prehistory */
diff --git a/libguile/print.c b/libguile/print.c
index 937454158..17153ba8f 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -70,7 +70,6 @@
#include "vm.h"
#include "weak-set.h"
#include "weak-table.h"
-#include "weak-vector.h"
#include "print.h"
@@ -564,8 +563,8 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
}
static void
-print_vector_or_weak_vector (SCM v, size_t len, SCM (*ref) (SCM, size_t),
- SCM port, scm_print_state *pstate)
+print_vector (SCM v, size_t len, SCM (*ref) (SCM, size_t),
+ SCM port, scm_print_state *pstate)
{
long i;
long last = len - 1;
@@ -710,8 +709,8 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
break;
case scm_tc7_values:
scm_puts ("#<values (", port);
- print_vector_or_weak_vector (exp, scm_i_nvalues (exp),
- scm_c_value_ref, port, pstate);
+ print_vector (exp, scm_i_nvalues (exp), scm_c_value_ref, port,
+ pstate);
scm_puts (">", port);
break;
case scm_tc7_program:
@@ -771,18 +770,11 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
case scm_tc7_thread:
scm_i_print_thread (exp, port, pstate);
break;
- case scm_tc7_wvect:
- ENTER_NESTED_DATA (pstate, exp, circref);
- scm_puts ("#w(", port);
- print_vector_or_weak_vector (exp, scm_c_weak_vector_length (exp),
- scm_c_weak_vector_ref, port, pstate);
- EXIT_NESTED_DATA (pstate);
- break;
case scm_tc7_vector:
ENTER_NESTED_DATA (pstate, exp, circref);
scm_puts ("#(", port);
- print_vector_or_weak_vector (exp, SCM_SIMPLE_VECTOR_LENGTH (exp),
- scm_c_vector_ref, port, pstate);
+ print_vector (exp, SCM_SIMPLE_VECTOR_LENGTH (exp), scm_c_vector_ref,
+ port, pstate);
EXIT_NESTED_DATA (pstate);
break;
case scm_tc7_port:
diff --git a/libguile/scm.h b/libguile/scm.h
index 75f02e7ce..97b38d61c 100644
--- a/libguile/scm.h
+++ b/libguile/scm.h
@@ -477,7 +477,7 @@ typedef uintptr_t scm_t_bits;
#define scm_tc7_symbol 0x05
#define scm_tc7_variable 0x07
#define scm_tc7_vector 0x0d
-#define scm_tc7_wvect 0x0f
+#define scm_tc7_unused_0f 0x0f
#define scm_tc7_string 0x15
#define scm_tc7_number 0x17
#define scm_tc7_hashtable 0x1d
diff --git a/libguile/weak-list.h b/libguile/weak-list.h
deleted file mode 100644
index 158a43033..000000000
--- a/libguile/weak-list.h
+++ /dev/null
@@ -1,66 +0,0 @@
-#ifndef SCM_WEAK_LIST_H
-#define SCM_WEAK_LIST_H
-
-/* Copyright 2016,2018
- Free Software Foundation, Inc.
-
- This file is part of Guile.
-
- Guile is free software: you can redistribute it and/or modify it
- under the terms of the GNU Lesser General Public License as published
- by the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- Guile is distributed in the hope that it will be useful, but WITHOUT
- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
- License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with Guile. If not, see
- <https://www.gnu.org/licenses/>. */
-
-
-
-#include "libguile/pairs.h"
-#include "libguile/weak-vector.h"
-
-
-
-static inline SCM
-scm_i_weak_cons (SCM car, SCM cdr)
-{
- return scm_cons (scm_c_make_weak_vector (1, car), cdr);
-}
-
-static inline SCM
-scm_i_weak_car (SCM pair)
-{
- return scm_c_weak_vector_ref (scm_car (pair), 0);
-}
-
-static inline void
-scm_i_visit_weak_list (SCM *list_loc, void (*visit) (SCM))
-{
- SCM in = *list_loc, out = SCM_EOL;
-
- while (scm_is_pair (in))
- {
- SCM car = scm_i_weak_car (in);
- SCM cdr = scm_cdr (in);
-
- if (!scm_is_eq (car, SCM_BOOL_F))
- {
- scm_set_cdr_x (in, out);
- out = in;
- visit (car);
- }
-
- in = cdr;
- }
-
- *list_loc = out;
-}
-
-
-#endif /* SCM_WEAK_LIST_H */
diff --git a/libguile/weak-set.c b/libguile/weak-set.c
index 1a5bc1577..ef6a5231d 100644
--- a/libguile/weak-set.c
+++ b/libguile/weak-set.c
@@ -36,8 +36,6 @@
#include "threads.h"
#include "weak-set.h"
-#include "weak-list.h"
-
/* Weak Sets
diff --git a/libguile/weak-table.c b/libguile/weak-table.c
index 571511256..5a4c68b6b 100644
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -37,7 +37,6 @@
#include "ports.h"
#include "procs.h"
#include "threads.h"
-#include "weak-list.h"
#include "weak-table.h"
diff --git a/libguile/weak-vector.c b/libguile/weak-vector.c
deleted file mode 100644
index 533a07ff0..000000000
--- a/libguile/weak-vector.c
+++ /dev/null
@@ -1,273 +0,0 @@
-/* Copyright 1995-1996,1998,2000-2001,2003,2006,2008-2014,2018,2025
- Free Software Foundation, Inc.
-
- This file is part of Guile.
-
- Guile is free software: you can redistribute it and/or modify it
- under the terms of the GNU Lesser General Public License as published
- by the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- Guile is distributed in the hope that it will be useful, but WITHOUT
- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
- License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with Guile. If not, see
- <https://www.gnu.org/licenses/>. */
-
-
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include <stdio.h>
-#include <string.h>
-
-#include "bdw-gc.h"
-#include "boolean.h"
-#include "extensions.h"
-#include "gsubr.h"
-#include "list.h"
-#include "pairs.h"
-#include "vectors.h"
-#include "version.h"
-
-#include "weak-vector.h"
-
-
-
-
-/* {Weak Vectors}
- */
-
-#define VECTOR_MAX_LENGTH (SCM_T_BITS_MAX >> 8)
-
-SCM
-scm_c_make_weak_vector (size_t len, SCM fill)
-#define FUNC_NAME "make-weak-vector"
-{
- SCM wv;
- size_t j;
-
- SCM_ASSERT_RANGE (1, scm_from_size_t (len), len <= VECTOR_MAX_LENGTH);
-
- if (SCM_UNBNDP (fill))
- fill = SCM_UNSPECIFIED;
-
- wv = SCM_PACK_POINTER (scm_gc_malloc_pointerless ((len + 1) * sizeof (SCM),
- "weak vector"));
-
- SCM_SET_CELL_WORD_0 (wv, (len << 8) | scm_tc7_wvect);
-
- if (SCM_HEAP_OBJECT_P (fill))
- {
- memset (SCM_I_VECTOR_WELTS (wv), 0, len * sizeof (SCM));
- for (j = 0; j < len; j++)
- scm_c_weak_vector_set_x (wv, j, fill);
- }
- else
- for (j = 0; j < len; j++)
- SCM_SIMPLE_VECTOR_SET (wv, j, fill);
-
- return wv;
-}
-#undef FUNC_NAME
-
-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"
- "argument @var{fill} is given, all entries in the vector will be\n"
- "set to @var{fill}. The default value for @var{fill} is the\n"
- "empty list.")
-#define FUNC_NAME s_scm_make_weak_vector
-{
- return scm_c_make_weak_vector (scm_to_size_t (size), fill);
-}
-#undef FUNC_NAME
-
-
-SCM_REGISTER_PROC(s_list_to_weak_vector, "list->weak-vector", 1, 0, 0,
scm_weak_vector);
-
-SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
- (SCM lst),
- "@deffnx {Scheme Procedure} list->weak-vector lst\n"
- "Construct a weak vector from a list: @code{weak-vector} uses\n"
- "the list of its arguments while @code{list->weak-vector} uses\n"
- "its only argument @var{l} (a list) to construct a weak vector\n"
- "the same way @code{list->vector} would.")
-#define FUNC_NAME s_scm_weak_vector
-{
- SCM wv;
- size_t i;
- long c_size;
-
- SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, lst, c_size);
-
- wv = scm_c_make_weak_vector ((size_t) c_size, SCM_BOOL_F);
-
- for (i = 0; scm_is_pair (lst); lst = SCM_CDR (lst), i++)
- scm_c_weak_vector_set_x (wv, i, SCM_CAR (lst));
-
- return wv;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} if @var{obj} is a weak vector. Note that all\n"
- "weak hashes are also weak vectors.")
-#define FUNC_NAME s_scm_weak_vector_p
-{
- return scm_from_bool (scm_is_weak_vector (obj));
-}
-#undef FUNC_NAME
-
-
-int
-scm_is_weak_vector (SCM obj)
-#define FUNC_NAME s_scm_weak_vector_p
-{
- return SCM_I_WVECTP (obj);
-}
-#undef FUNC_NAME
-
-
-#define SCM_VALIDATE_WEAK_VECTOR(pos, var) \
- SCM_I_MAKE_VALIDATE_MSG2 (pos, var, SCM_I_WVECTP, "weak vector")
-
-
-SCM_DEFINE (scm_weak_vector_length, "weak-vector-length", 1, 0, 0,
- (SCM wvect),
- "Like @code{vector-length}, but for weak vectors.")
-#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
-
-
-struct weak_vector_ref_data
-{
- SCM wv;
- size_t k;
-};
-
-static void*
-weak_vector_ref (void *data)
-{
- struct weak_vector_ref_data *d = data;
-
- return (void *) SCM_UNPACK (SCM_SIMPLE_VECTOR_REF (d->wv, d->k));
-}
-
-SCM
-scm_c_weak_vector_ref (SCM wv, size_t k)
-#define FUNC_NAME s_scm_weak_vector_ref
-{
- struct weak_vector_ref_data d;
- void *ret;
-
- SCM_VALIDATE_WEAK_VECTOR (1, wv);
-
- d.wv = wv;
- d.k = k;
-
- if (k >= SCM_I_VECTOR_LENGTH (wv))
- scm_out_of_range ("weak-vector-ref", scm_from_size_t (k));
-
- ret = GC_call_with_alloc_lock (weak_vector_ref, &d);
-
- if (ret)
- return SCM_PACK_POINTER (ret);
- else
- return SCM_BOOL_F;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_weak_vector_set_x, "weak-vector-set!", 3, 0, 0,
- (SCM wvect, SCM k, SCM obj),
- "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), obj);
-
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-void
-scm_c_weak_vector_set_x (SCM wv, size_t k, SCM x)
-#define FUNC_NAME s_scm_weak_vector_set_x
-{
- SCM *elts;
- struct weak_vector_ref_data d;
- void *prev;
-
- SCM_VALIDATE_WEAK_VECTOR (1, wv);
-
- d.wv = wv;
- d.k = k;
-
- if (k >= SCM_I_VECTOR_LENGTH (wv))
- scm_out_of_range ("weak-vector-set!", scm_from_size_t (k));
-
- prev = GC_call_with_alloc_lock (weak_vector_ref, &d);
-
- elts = SCM_I_VECTOR_WELTS (wv);
-
- if (prev && SCM_HEAP_OBJECT_P (SCM_PACK_POINTER (prev)))
- GC_unregister_disappearing_link ((void **) &elts[k]);
-
- elts[k] = x;
-
- if (SCM_HEAP_OBJECT_P (x))
- SCM_I_REGISTER_DISAPPEARING_LINK ((void **) &elts[k],
- SCM2PTR (x));
-}
-#undef FUNC_NAME
-
-
-
-static void
-scm_init_weak_vector_builtins (void)
-{
-#ifndef SCM_MAGIC_SNARFER
-#include "weak-vector.x"
-#endif
-}
-
-void
-scm_init_weak_vectors ()
-{
- scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
- "scm_init_weak_vector_builtins",
-
(scm_t_extension_init_func)scm_init_weak_vector_builtins,
- NULL);
-}
-
diff --git a/libguile/weak-vector.h b/libguile/weak-vector.h
deleted file mode 100644
index e22f63c8b..000000000
--- a/libguile/weak-vector.h
+++ /dev/null
@@ -1,48 +0,0 @@
-#ifndef SCM_WEAK_VECTOR_H
-#define SCM_WEAK_VECTOR_H
-
-/* Copyright 1995-1996,2000-2001,2003,2006,2008-2009,2011,2014,2018
- Free Software Foundation, Inc.
-
- This file is part of Guile.
-
- Guile is free software: you can redistribute it and/or modify it
- under the terms of the GNU Lesser General Public License as published
- by the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- Guile is distributed in the hope that it will be useful, but WITHOUT
- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
- License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with Guile. If not, see
- <https://www.gnu.org/licenses/>. */
-
-
-
-#include "libguile/scm.h"
-
-
-/* Weak vectors. */
-
-#define SCM_I_WVECTP(x) (SCM_HAS_TYP7 (x, scm_tc7_wvect))
-
-SCM_API SCM scm_make_weak_vector (SCM len, 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 len, 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_INTERNAL void scm_init_weak_vectors (void);
-
-
-#endif /* SCM_WEAK_VECTOR_H */
diff --git a/module/ice-9/weak-vector.scm b/module/ice-9/weak-vector.scm
index 0df8e1a45..5a89e6831 100644
--- a/module/ice-9/weak-vector.scm
+++ b/module/ice-9/weak-vector.scm
@@ -1,6 +1,6 @@
;;; installed-scm-file
-;;;; Copyright (C) 2003, 2006, 2011, 2014 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006, 2011, 2014, 2025 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
@@ -19,6 +19,9 @@
(define-module (ice-9 weak-vector)
+ #:use-module (ice-9 ephemerons)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-9)
#:export (make-weak-vector
list->weak-vector
weak-vector
@@ -26,6 +29,54 @@
weak-vector-ref
weak-vector-set!))
-(eval-when (load eval compile)
- (load-extension (string-append "libguile-" (effective-version))
- "scm_init_weak_vector_builtins"))
+(define (immediate? x)
+ (cond
+ ((exact-integer? x) (<= most-negative-fixnum x most-positive-fixnum))
+ ((char? x) #t)
+ ((eq? x #f) #t)
+ ((eq? x #nil) #t)
+ ((eq? x '()) #t)
+ ((eq? x #t) #t)
+ ((unspecified? x) #t)
+ ((eof-object? x) #t)
+ (else #f)))
+
+(define-record-type <weak-vector>
+ (%make-weak-vector weaks)
+ weak-vector?
+ (weaks weak-vector-weaks))
+
+(define* (make-weak-vector size #:optional (fill #f))
+ (let ((wv (%make-weak-vector (make-vector size #f))))
+ (let lp ((i 0))
+ (when (< i size)
+ (weak-vector-set! wv i fill)
+ (lp (1+ i))))
+ wv))
+
+(define (make-weak val)
+ (if (immediate? val)
+ val
+ (make-ephemeron val #t)))
+
+(define (weak-vector-set! wv idx val)
+ (vector-set! (weak-vector-weaks wv) idx (make-weak val))
+ (values))
+
+(define (weak-vector-ref wv idx)
+ (let ((weak (vector-ref (weak-vector-weaks wv) idx)))
+ (if (ephemeron? weak)
+ (ephemeron-key weak)
+ weak)))
+
+(define (list->weak-vector ls)
+ (let ((wv (make-weak-vector (length ls) #f)))
+ (let lp ((ls ls) (idx 0))
+ (match ls
+ (() wv)
+ ((elt . ls)
+ (weak-vector-set! wv idx elt)
+ (lp ls (1+ idx)))))))
+
+(define (weak-vector . elts)
+ (list->weak-vector elts))
diff --git a/module/system/base/types.scm b/module/system/base/types.scm
index 75235ea07..c1899bdb0 100644
--- a/module/system/base/types.scm
+++ b/module/system/base/types.scm
@@ -431,8 +431,6 @@ using BACKEND."
(bytevector->uint-list words (native-endianness)
%word-size)))
vector)))
- (((_ & #x7f = %tc7-weak-vector))
- (inferior-object 'weak-vector address)) ; TODO: show elements
(((_ & #x7f = %tc7-fluid) init-value)
(inferior-object 'fluid address))
(((_ & #x7f = %tc7-dynamic-state))
diff --git a/module/system/base/types/internal.scm
b/module/system/base/types/internal.scm
index 6b774a48c..b739f9a9a 100644
--- a/module/system/base/types/internal.scm
+++ b/module/system/base/types/internal.scm
@@ -36,7 +36,6 @@
%tc7-vector
%tc8-immutable-vector
%tc8-mutable-vector
- %tc7-weak-vector
%tc7-string
%tc7-heap-number
%tc7-hash-table
@@ -132,7 +131,7 @@
(vector vector? #b1111111 #b0001101)
(immutable-vector immutable-vector? #b11111111 #b10001101)
(mutable-vector mutable-vector? #b11111111 #b00001101)
- (weak-vector weak-vector? #b1111111 #b0001111)
+ ;;(unused unused #b1111111 #b0001111)
(string string? #b1111111 #b0010101)
(heap-number heap-number? #b1111111 #b0010111)
(hash-table hash-table? #b1111111 #b0011101)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index a1d748df7..8b228d2e3 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -118,7 +118,6 @@
emit-vector?
emit-mutable-vector?
emit-immutable-vector?
- emit-weak-vector?
emit-string?
emit-heap-number?
emit-hash-table?
diff --git a/test-suite/tests/types.test b/test-suite/tests/types.test
index 03dbea83a..778aaa6bd 100644
--- a/test-suite/tests/types.test
+++ b/test-suite/tests/types.test
@@ -22,7 +22,6 @@
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
- #:use-module (ice-9 weak-vector)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (system foreign)
@@ -101,7 +100,6 @@
((open-input-string "hello") port (? inferior-object?))
((lambda () #t) program _)
((make-variable 'foo) variable _)
- ((make-weak-vector 3 #t) weak-vector _)
((make-weak-key-hash-table) weak-table _)
((make-weak-value-hash-table) weak-table _)
((make-doubly-weak-hash-table) weak-table _)
