diff options
Diffstat (limited to 'libguile/procprop.c')
-rw-r--r-- | libguile/procprop.c | 70 |
1 files changed, 17 insertions, 53 deletions
diff --git a/libguile/procprop.c b/libguile/procprop.c index c3fb90e37..2ad941d6a 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -22,20 +22,16 @@ # include <config.h> #endif -#define SCM_BUILDING_DEPRECATED_CODE - #include "libguile/_scm.h" #include "libguile/alist.h" -#include "libguile/deprecation.h" -#include "libguile/deprecated.h" #include "libguile/eval.h" #include "libguile/procs.h" #include "libguile/gsubr.h" #include "libguile/smob.h" #include "libguile/root.h" #include "libguile/vectors.h" -#include "libguile/hashtab.h" +#include "libguile/weak-table.h" #include "libguile/programs.h" #include "libguile/validate.h" @@ -43,36 +39,29 @@ SCM_GLOBAL_SYMBOL (scm_sym_system_procedure, "system-procedure"); -#if (SCM_ENABLE_DEPRECATED == 1) -SCM_GLOBAL_SYMBOL (scm_sym_arity, "arity"); -#endif SCM_GLOBAL_SYMBOL (scm_sym_name, "name"); static SCM overrides; -static scm_i_pthread_mutex_t overrides_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; int scm_i_procedure_arity (SCM proc, int *req, int *opt, int *rest) { while (!SCM_PROGRAM_P (proc)) { - if (SCM_IMP (proc)) - return 0; - switch (SCM_TYP7 (proc)) + if (SCM_STRUCTP (proc)) { - case scm_tc7_smob: - if (!SCM_SMOB_APPLICABLE_P (proc)) - return 0; - proc = scm_i_smob_apply_trampoline (proc); - break; - case scm_tcs_struct: if (!SCM_STRUCT_APPLICABLE_P (proc)) return 0; proc = SCM_STRUCT_PROCEDURE (proc); - break; - default: - return 0; } + else if (SCM_HAS_TYP7 (proc, scm_tc7_smob)) + { + if (!SCM_SMOB_APPLICABLE_P (proc)) + return 0; + proc = scm_i_smob_apply_trampoline (proc); + } + else + return 0; } return scm_i_program_arity (proc, req, opt, rest); } @@ -111,9 +100,7 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0, SCM_VALIDATE_PROC (1, proc); - scm_i_pthread_mutex_lock (&overrides_lock); - ret = scm_hashq_ref (overrides, proc, SCM_BOOL_F); - scm_i_pthread_mutex_unlock (&overrides_lock); + ret = scm_weak_table_refq (overrides, proc, SCM_BOOL_F); if (scm_is_false (ret)) { @@ -123,10 +110,6 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0, ret = SCM_EOL; } -#if (SCM_ENABLE_DEPRECATED == 1) - ret = scm_acons (scm_sym_arity, scm_procedure_minimum_arity (proc), ret); -#endif - return ret; } #undef FUNC_NAME @@ -138,14 +121,7 @@ SCM_DEFINE (scm_set_procedure_properties_x, "set-procedure-properties!", 2, 0, 0 { SCM_VALIDATE_PROC (1, proc); -#if (SCM_ENABLE_DEPRECATED == 1) - if (scm_assq (alist, scm_sym_arity)) - SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL); -#endif - - scm_i_pthread_mutex_lock (&overrides_lock); - scm_hashq_set_x (overrides, proc, alist); - scm_i_pthread_mutex_unlock (&overrides_lock); + scm_weak_table_putq_x (overrides, proc, alist); return SCM_UNSPECIFIED; } @@ -158,13 +134,6 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0, { SCM_VALIDATE_PROC (1, proc); -#if (SCM_ENABLE_DEPRECATED == 1) - if (scm_is_eq (key, scm_sym_arity)) - scm_c_issue_deprecation_warning - ("Accessing a procedure's arity via `procedure-property' is deprecated.\n" - "Use `procedure-minimum-arity instead."); -#endif - return scm_assq_ref (scm_procedure_properties (proc), key); } #undef FUNC_NAME @@ -179,13 +148,8 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, SCM_VALIDATE_PROC (1, proc); -#if (SCM_ENABLE_DEPRECATED == 1) - if (scm_is_eq (key, scm_sym_arity)) - SCM_MISC_ERROR ("arity is a deprecated read-only property", SCM_EOL); -#endif - - scm_i_pthread_mutex_lock (&overrides_lock); - props = scm_hashq_ref (overrides, proc, SCM_BOOL_F); + scm_i_pthread_mutex_lock (&scm_i_misc_mutex); + props = scm_weak_table_refq (overrides, proc, SCM_BOOL_F); if (scm_is_false (props)) { if (SCM_PROGRAM_P (proc)) @@ -193,8 +157,8 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, else props = SCM_EOL; } - scm_hashq_set_x (overrides, proc, scm_assq_set_x (props, key, val)); - scm_i_pthread_mutex_unlock (&overrides_lock); + scm_weak_table_putq_x (overrides, proc, scm_assq_set_x (props, key, val)); + scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); return SCM_UNSPECIFIED; } @@ -206,7 +170,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, void scm_init_procprop () { - overrides = scm_make_weak_key_hash_table (SCM_UNDEFINED); + overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY); #include "libguile/procprop.x" } |