summaryrefslogtreecommitdiff
path: root/libguile/procprop.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/procprop.c')
-rw-r--r--libguile/procprop.c47
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);