summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-01-16 13:18:05 +0100
committerAndy Wingo <wingo@pobox.com>2015-01-23 16:16:03 +0100
commit2bcb278a30f53b68021d4c7e369df21351244b4c (patch)
tree7184edd8dee8c5fb2d3caed5521724440fe9ab24 /libguile
parent9539b20ba92c84296f6e453175844d5a5614d307 (diff)
downloadguile-2bcb278a30f53b68021d4c7e369df21351244b4c.tar.gz
GOOPS: Deprecate "using-class" procs like slot-ref-using-class
* libguile/deprecated.h: * libguile/goops.c: * libguile/goops.h: * libguile/deprecated.c (scm_slot_ref_using_class): (scm_slot_set_using_class_x): (scm_slot_bound_using_class_p): (scm_slot_exists_using_class_p): Deprecate. * module/oop/goops.scm (slot-ref-using-class, slot-set-using-class!) (slot-bound-using-class?, slot-exists-using-class?): Deprecate. Change to check that `class' is indeed the class of `obj', as required, and then dispatch to slot-ref et al.
Diffstat (limited to 'libguile')
-rw-r--r--libguile/deprecated.c39
-rw-r--r--libguile/deprecated.h4
-rw-r--r--libguile/goops.c38
-rw-r--r--libguile/goops.h4
4 files changed, 43 insertions, 42 deletions
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 4a82e4f5e..b8c3c8ce1 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -93,6 +93,11 @@ scm_memory_error (const char *subr)
+static SCM var_slot_ref_using_class = SCM_BOOL_F;
+static SCM var_slot_set_using_class_x = SCM_BOOL_F;
+static SCM var_slot_bound_using_class_p = SCM_BOOL_F;
+static SCM var_slot_exists_using_class_p = SCM_BOOL_F;
+
SCM scm_no_applicable_method = SCM_BOOL_F;
SCM var_get_keyword = SCM_BOOL_F;
@@ -130,6 +135,11 @@ SCM *scm_port_class, *scm_smob_class;
void
scm_init_deprecated_goops (void)
{
+ var_slot_ref_using_class = scm_c_lookup ("slot-ref-using-class");
+ var_slot_set_using_class_x = scm_c_lookup ("slot-set-using-class!");
+ var_slot_bound_using_class_p = scm_c_lookup ("slot-bound-using-class?");
+ var_slot_exists_using_class_p = scm_c_lookup ("slot-exists-using-class?");
+
scm_no_applicable_method =
scm_variable_ref (scm_c_lookup ("no-applicable-method"));
@@ -446,6 +456,35 @@ scm_basic_make_class (SCM meta, SCM name, SCM dsupers, SCM dslots)
return scm_make_standard_class (meta, name, dsupers, dslots);
}
+/* Scheme will issue the deprecation warning for these. */
+SCM
+scm_slot_ref_using_class (SCM class, SCM obj, SCM slot_name)
+{
+ return scm_call_3 (scm_variable_ref (var_slot_ref_using_class),
+ class, obj, slot_name);
+}
+
+SCM
+scm_slot_set_using_class_x (SCM class, SCM obj, SCM slot_name, SCM value)
+{
+ return scm_call_4 (scm_variable_ref (var_slot_set_using_class_x),
+ class, obj, slot_name, value);
+}
+
+SCM
+scm_slot_bound_using_class_p (SCM class, SCM obj, SCM slot_name)
+{
+ return scm_call_3 (scm_variable_ref (var_slot_bound_using_class_p),
+ class, obj, slot_name);
+}
+
+SCM
+scm_slot_exists_using_class_p (SCM class, SCM obj, SCM slot_name)
+{
+ return scm_call_3 (scm_variable_ref (var_slot_exists_using_class_p),
+ class, obj, slot_name);
+}
+
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index b731e0b84..1f13bde83 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -212,6 +212,10 @@ SCM_DEPRECATED SCM scm_compute_applicable_methods (SCM gf, SCM args, long len, i
SCM_DEPRECATED SCM scm_find_method (SCM l);
SCM_DEPRECATED SCM scm_basic_make_class (SCM c, SCM name, SCM dsupers, SCM dslots);
SCM_DEPRECATED SCM scm_get_keyword (SCM kw, SCM initargs, SCM default_value);
+SCM_DEPRECATED SCM scm_slot_ref_using_class (SCM cls, SCM obj, SCM slot_name);
+SCM_DEPRECATED SCM scm_slot_set_using_class_x (SCM cls, SCM obj, SCM slot_name, SCM value);
+SCM_DEPRECATED SCM scm_slot_bound_using_class_p (SCM cls, SCM obj, SCM slot_name);
+SCM_DEPRECATED SCM scm_slot_exists_using_class_p (SCM cls, SCM obj, SCM slot_name);
diff --git a/libguile/goops.c b/libguile/goops.c
index 42b7a1b33..c7e775c86 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -91,11 +91,6 @@ static SCM var_method_generic_function = SCM_BOOL_F;
static SCM var_method_specializers = SCM_BOOL_F;
static SCM var_method_procedure = SCM_BOOL_F;
-static SCM var_slot_ref_using_class = SCM_BOOL_F;
-static SCM var_slot_set_using_class_x = SCM_BOOL_F;
-static SCM var_slot_bound_using_class_p = SCM_BOOL_F;
-static SCM var_slot_exists_using_class_p = SCM_BOOL_F;
-
static SCM var_slot_ref = SCM_BOOL_F;
static SCM var_slot_set_x = SCM_BOOL_F;
static SCM var_slot_bound_p = SCM_BOOL_F;
@@ -455,34 +450,6 @@ SCM_DEFINE (scm_unbound_p, "unbound?", 1, 0, 0,
SCM
-scm_slot_ref_using_class (SCM class, SCM obj, SCM slot_name)
-{
- return scm_call_3 (scm_variable_ref (var_slot_ref_using_class),
- class, obj, slot_name);
-}
-
-SCM
-scm_slot_set_using_class_x (SCM class, SCM obj, SCM slot_name, SCM value)
-{
- return scm_call_4 (scm_variable_ref (var_slot_set_using_class_x),
- class, obj, slot_name, value);
-}
-
-SCM
-scm_slot_bound_using_class_p (SCM class, SCM obj, SCM slot_name)
-{
- return scm_call_3 (scm_variable_ref (var_slot_bound_using_class_p),
- class, obj, slot_name);
-}
-
-SCM
-scm_slot_exists_using_class_p (SCM class, SCM obj, SCM slot_name)
-{
- return scm_call_3 (scm_variable_ref (var_slot_exists_using_class_p),
- class, obj, slot_name);
-}
-
-SCM
scm_slot_ref (SCM obj, SCM slot_name)
{
return scm_call_2 (scm_variable_ref (var_slot_ref), obj, slot_name);
@@ -977,11 +944,6 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
/* For SCM_SUBCLASSP. */
var_class_precedence_list = scm_c_lookup ("class-precedence-list");
- var_slot_ref_using_class = scm_c_lookup ("slot-ref-using-class");
- var_slot_set_using_class_x = scm_c_lookup ("slot-set-using-class!");
- var_slot_bound_using_class_p = scm_c_lookup ("slot-bound-using-class?");
- var_slot_exists_using_class_p = scm_c_lookup ("slot-exists-using-class?");
-
var_slot_ref = scm_c_lookup ("slot-ref");
var_slot_set_x = scm_c_lookup ("slot-set!");
var_slot_bound_p = scm_c_lookup ("slot-bound?");
diff --git a/libguile/goops.h b/libguile/goops.h
index e83bf093b..3dd3f3e45 100644
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -116,10 +116,6 @@ SCM_API SCM scm_generic_function_methods (SCM obj);
SCM_API SCM scm_method_generic_function (SCM obj);
SCM_API SCM scm_method_specializers (SCM obj);
SCM_API SCM scm_method_procedure (SCM obj);
-SCM_API SCM scm_slot_ref_using_class (SCM cls, SCM obj, SCM slot_name);
-SCM_API SCM scm_slot_set_using_class_x (SCM cls, SCM obj, SCM slot_name, SCM value);
-SCM_API SCM scm_slot_bound_using_class_p (SCM cls, SCM obj, SCM slot_name);
-SCM_API SCM scm_slot_exists_using_class_p (SCM cls, SCM obj, SCM slot_name);
SCM_API SCM scm_slot_bound_p (SCM obj, SCM slot_name);
SCM_API SCM scm_slot_exists_p (SCM obj, SCM slot_name);
SCM_API SCM scm_sys_modify_instance (SCM old, SCM newinst);