mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-23 03:54:12 +02:00
Code Activity

Rework procedure properties to use ephemeron hash tables

Browse source 
* libguile/procprop.c: Use ephemeron tables instead of weak tables.
This commit is contained in:
Andy Wingo 2025-05-09 13:14:48 +02:00
parent 2463a0741f
commit bdadd4b057
1 changed files with 18 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

35
libguile/procprop.c
View file

@ -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 ();
}