diff options
author | Andy Wingo <wingo@pobox.com> | 2010-04-17 16:28:52 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-04-17 16:28:52 +0200 |
commit | 3fc7e2c12370f4c6386dafe127640f1ef1c6d76b (patch) | |
tree | fa98054a196d1515704c3c9a40093e31c83b1e84 /libguile/procprop.c | |
parent | cb2ce548441824fe1284fc80a3a95394a9fc03d0 (diff) | |
download | guile-3fc7e2c12370f4c6386dafe127640f1ef1c6d76b.tar.gz |
deprecate arity access via (procedure-properties proc 'arity)
* libguile/procprop.h (scm_sym_arity): Deprecate. I didn't move it to
deprecated.h though, because that might have some boot implications --
though I didn't check.
* libguile/procprop.c (scm_procedure_properties)
(scm_set_procedure_properties_x, scm_procedure_property)
(scm_set_procedure_property_x): Deprecate access to a procedure's
arity via procedure-properties. Users should use
procedure-minimum-arity.
* module/ice-9/channel.scm (eval):
* module/ice-9/session.scm (arity):
* module/language/tree-il/analyze.scm (validate-arity): Fix up instances
of (procedure-property x 'arity) to use procedure-minimum-arity.
Diffstat (limited to 'libguile/procprop.c')
-rw-r--r-- | libguile/procprop.c | 47 |
1 files changed, 29 insertions, 18 deletions
diff --git a/libguile/procprop.c b/libguile/procprop.c index b7575d199..2263d283a 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -22,9 +22,13 @@ # 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" @@ -39,7 +43,9 @@ 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; @@ -102,7 +108,6 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0, #define FUNC_NAME s_scm_procedure_properties { SCM ret; - int req, opt, rest; SCM_VALIDATE_PROC (1, proc); @@ -118,13 +123,11 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0, ret = SCM_EOL; } - scm_i_procedure_arity (proc, &req, &opt, &rest); +#if (SCM_ENABLE_DEPRECATED == 1) + ret = scm_acons (scm_sym_arity, scm_procedure_minimum_arity (proc), ret); +#endif - return scm_acons (scm_sym_arity, - scm_list_3 (scm_from_int (req), - scm_from_int (opt), - scm_from_bool (rest)), - ret); + return ret; } #undef FUNC_NAME @@ -135,8 +138,10 @@ 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); @@ -153,17 +158,14 @@ 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)) - /* avoid a cons in this case */ - { - int req, opt, rest; - scm_i_procedure_arity (proc, &req, &opt, &rest); - return scm_list_3 (scm_from_int (req), - scm_from_int (opt), - scm_from_bool (rest)); - } - else - return scm_assq_ref (scm_procedure_properties (proc), key); + 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 @@ -176,10 +178,19 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, SCM props; SCM_VALIDATE_PROC (1, proc); + +#if (SCM_ENABLE_DEPRECATED == 1) if (scm_is_eq (key, scm_sym_arity)) - SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL); + SCM_MISC_ERROR ("arity is a deprecated read-only property", SCM_EOL); +#endif props = scm_procedure_properties (proc); + +#if (SCM_ENABLE_DEPRECATED == 1) + /* cdr past the consed-on arity. */ + props = scm_cdr (props); +#endif + scm_i_pthread_mutex_lock (&overrides_lock); scm_hashq_set_x (overrides, proc, scm_assq_set_x (props, key, val)); scm_i_pthread_mutex_unlock (&overrides_lock); |