wingo pushed a commit to branch wip-whippet
in repository guile.
commit bdadd4b057e0904d796325cb06fbd366cc6342e3
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri May 9 13:14:48 2025 +0200
Rework procedure properties to use ephemeron hash tables
* libguile/procprop.c: Use ephemeron tables instead of weak tables.
---
libguile/procprop.c | 35 ++++++++++++++++++-----------------
1 file changed, 18 insertions(+), 17 deletions(-)
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 89cc6c2f7..a86de57ed 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1996,1998,2000-2001,2003-2004,2006,2008-2013,2018
+/* Copyright 1995-1996,1998,2000-2001,2003-2004,2006,2008-2013,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -27,6 +27,7 @@
#include "alist.h"
#include "boolean.h"
#include "eval.h"
+#include "ephemerons.h"
#include "gsubr.h"
#include "list.h"
#include "numbers.h"
@@ -38,7 +39,6 @@
#include "threads.h"
#include "vectors.h"
#include "vm-builtins.h"
-#include "weak-table.h"
#include "procprop.h"
@@ -48,16 +48,16 @@
SCM_GLOBAL_SYMBOL (scm_sym_system_procedure, "system-procedure");
SCM_GLOBAL_SYMBOL (scm_sym_name, "name");
-static SCM overrides;
+static struct scm_ephemeron_table *overrides;
-static SCM arity_overrides;
+static struct scm_ephemeron_table *arity_overrides;
int
scm_i_procedure_arity (SCM proc, int *req, int *opt, int *rest)
{
SCM o;
- o = scm_weak_table_refq (arity_overrides, proc, SCM_BOOL_F);
+ o = scm_c_ephemeron_hash_table_refq (arity_overrides, proc, SCM_BOOL_F);
if (scm_is_true (o))
{
@@ -108,7 +108,8 @@ SCM_DEFINE (scm_set_procedure_minimum_arity_x,
"set-procedure-minimum-arity!",
SCM_VALIDATE_INT_COPY (3, opt, t);
SCM_VALIDATE_BOOL (4, rest);
- scm_weak_table_putq_x (arity_overrides, proc, scm_list_3 (req, opt, rest));
+ scm_c_ephemeron_hash_table_setq_x (arity_overrides, proc,
+ scm_list_3 (req, opt, rest));
return SCM_UNDEFINED;
}
#undef FUNC_NAME
@@ -147,7 +148,7 @@ SCM_DEFINE (scm_procedure_properties,
"procedure-properties", 1, 0, 0,
SCM_VALIDATE_PROC (1, proc);
- user_props = scm_weak_table_refq (overrides, proc, SCM_BOOL_F);
+ user_props = scm_c_ephemeron_hash_table_refq (overrides, proc, SCM_BOOL_F);
if (scm_is_pair (user_props) && scm_is_true (scm_car (user_props)))
return scm_cdr (user_props);
@@ -174,7 +175,8 @@ SCM_DEFINE (scm_set_procedure_properties_x,
"set-procedure-properties!", 2, 0, 0
{
SCM_VALIDATE_PROC (1, proc);
- scm_weak_table_putq_x (overrides, proc, scm_cons (SCM_BOOL_T, alist));
+ scm_c_ephemeron_hash_table_setq_x (overrides, proc,
+ scm_cons (SCM_BOOL_T, alist));
return SCM_UNSPECIFIED;
}
@@ -194,7 +196,7 @@ SCM_DEFINE (scm_procedure_property, "procedure-property",
2, 0, 0,
if (scm_is_eq (key, scm_sym_documentation))
return scm_procedure_documentation (proc);
- user_props = scm_weak_table_refq (overrides, proc, SCM_BOOL_F);
+ user_props = scm_c_ephemeron_hash_table_refq (overrides, proc, SCM_BOOL_F);
if (scm_is_true (user_props))
{
SCM pair = scm_assq (key, scm_cdr (user_props));
@@ -219,7 +221,7 @@ SCM_DEFINE (scm_set_procedure_property_x,
"set-procedure-property!", 3, 0, 0,
SCM_VALIDATE_PROC (1, proc);
scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
- user_props = scm_weak_table_refq (overrides, proc, SCM_BOOL_F);
+ user_props = scm_c_ephemeron_hash_table_refq (overrides, proc, SCM_BOOL_F);
if (scm_is_false (user_props))
{
override_p = SCM_BOOL_F;
@@ -230,9 +232,8 @@ SCM_DEFINE (scm_set_procedure_property_x,
"set-procedure-property!", 3, 0, 0,
override_p = scm_car (user_props);
user_props = scm_cdr (user_props);
}
- scm_weak_table_putq_x (overrides, proc,
- scm_cons (override_p,
- scm_assq_set_x (user_props, key, val)));
+ SCM props = scm_cons (override_p, scm_assq_set_x (user_props, key, val));
+ scm_c_ephemeron_hash_table_setq_x (overrides, proc, props);
scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
return SCM_UNSPECIFIED;
@@ -254,7 +255,7 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
SCM_VALIDATE_PROC (1, proc);
- user_props = scm_weak_table_refq (overrides, proc, SCM_BOOL_F);
+ user_props = scm_c_ephemeron_hash_table_refq (overrides, proc, SCM_BOOL_F);
if (scm_is_true (user_props))
{
SCM pair = scm_assq (scm_sym_name, scm_cdr (user_props));
@@ -291,7 +292,7 @@ SCM_DEFINE (scm_procedure_documentation,
"procedure-documentation", 1, 0, 0,
while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
proc = SCM_STRUCT_PROCEDURE (proc);
- user_props = scm_weak_table_refq (overrides, proc, SCM_BOOL_F);
+ user_props = scm_c_ephemeron_hash_table_refq (overrides, proc, SCM_BOOL_F);
if (scm_is_true (user_props))
{
SCM pair = scm_assq (scm_sym_documentation, scm_cdr (user_props));
@@ -339,8 +340,8 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0,
0,
void
scm_init_procprop ()
{
- overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
- arity_overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
+ overrides = scm_c_make_ephemeron_table (1001);
+ arity_overrides = scm_c_make_ephemeron_table (113);
#include "procprop.x"
scm_init_vm_builtin_properties ();
}
