mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-02 02:10:19 +02:00
Rework procedure properties to use ephemeron hash tables
* libguile/procprop.c: Use ephemeron tables instead of weak tables.
This commit is contained in:
parent
2463a0741f
commit
bdadd4b057
1 changed files with 18 additions and 17 deletions
|
@ -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 ();
|
||||
}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue