\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;
+
SCM scm_no_applicable_method = SCM_BOOL_F;
+SCM var_get_keyword = SCM_BOOL_F;
+
+SCM scm_class_boolean, scm_class_char, scm_class_pair;
+SCM scm_class_procedure, scm_class_string, scm_class_symbol;
+SCM scm_class_primitive_generic;
+SCM scm_class_vector, scm_class_null;
+SCM scm_class_integer, scm_class_real, scm_class_complex, scm_class_fraction;
+SCM scm_class_unknown;
+SCM scm_class_top, scm_class_object, scm_class_class;
+SCM scm_class_applicable;
+SCM scm_class_applicable_struct, scm_class_applicable_struct_with_setter;
+SCM scm_class_generic, scm_class_generic_with_setter;
+SCM scm_class_accessor;
+SCM scm_class_extended_generic, scm_class_extended_generic_with_setter;
+SCM scm_class_extended_accessor;
+SCM scm_class_method;
+SCM scm_class_accessor_method;
+SCM scm_class_procedure_class;
+SCM scm_class_applicable_struct_class;
+SCM scm_class_number, scm_class_list;
+SCM scm_class_keyword;
+SCM scm_class_port, scm_class_input_output_port;
+SCM scm_class_input_port, scm_class_output_port;
+SCM scm_class_foreign_slot;
+SCM scm_class_self, scm_class_protected;
+SCM scm_class_hidden, scm_class_opaque, scm_class_read_only;
+SCM scm_class_protected_hidden, scm_class_protected_opaque, scm_class_protected_read_only;
+SCM scm_class_scm;
+SCM scm_class_int, scm_class_float, scm_class_double;
+
+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"));
+
+ var_get_keyword = scm_c_lookup ("get-keyword");
+
+ scm_class_class = scm_variable_ref (scm_c_lookup ("<class>"));
+ scm_class_top = scm_variable_ref (scm_c_lookup ("<top>"));
+ scm_class_object = scm_variable_ref (scm_c_lookup ("<object>"));
+
+ scm_class_foreign_slot = scm_variable_ref (scm_c_lookup ("<foreign-slot>"));
+ scm_class_protected = scm_variable_ref (scm_c_lookup ("<protected-slot>"));
+ scm_class_hidden = scm_variable_ref (scm_c_lookup ("<hidden-slot>"));
+ scm_class_opaque = scm_variable_ref (scm_c_lookup ("<opaque-slot>"));
+ scm_class_read_only = scm_variable_ref (scm_c_lookup ("<read-only-slot>"));
+ scm_class_self = scm_variable_ref (scm_c_lookup ("<self-slot>"));
+ scm_class_protected_opaque = scm_variable_ref (scm_c_lookup ("<protected-opaque-slot>"));
+ scm_class_protected_hidden = scm_variable_ref (scm_c_lookup ("<protected-hidden-slot>"));
+ scm_class_protected_read_only = scm_variable_ref (scm_c_lookup ("<protected-read-only-slot>"));
+ scm_class_scm = scm_variable_ref (scm_c_lookup ("<scm-slot>"));
+ scm_class_int = scm_variable_ref (scm_c_lookup ("<int-slot>"));
+ scm_class_float = scm_variable_ref (scm_c_lookup ("<float-slot>"));
+ scm_class_double = scm_variable_ref (scm_c_lookup ("<double-slot>"));
+
+ /* scm_class_generic functions classes */
+ scm_class_procedure_class = scm_variable_ref (scm_c_lookup ("<procedure-class>"));
+ scm_class_applicable_struct_class = scm_variable_ref (scm_c_lookup ("<applicable-struct-class>"));
+
+ scm_class_method = scm_variable_ref (scm_c_lookup ("<method>"));
+ scm_class_accessor_method = scm_variable_ref (scm_c_lookup ("<accessor-method>"));
+ scm_class_applicable = scm_variable_ref (scm_c_lookup ("<applicable>"));
+ scm_class_applicable_struct = scm_variable_ref (scm_c_lookup ("<applicable-struct>"));
+ scm_class_applicable_struct_with_setter = scm_variable_ref (scm_c_lookup ("<applicable-struct-with-setter>"));
+ scm_class_generic = scm_variable_ref (scm_c_lookup ("<generic>"));
+ scm_class_extended_generic = scm_variable_ref (scm_c_lookup ("<extended-generic>"));
+ scm_class_generic_with_setter = scm_variable_ref (scm_c_lookup ("<generic-with-setter>"));
+ scm_class_accessor = scm_variable_ref (scm_c_lookup ("<accessor>"));
+ scm_class_extended_generic_with_setter = scm_variable_ref (scm_c_lookup ("<extended-generic-with-setter>"));
+ scm_class_extended_accessor = scm_variable_ref (scm_c_lookup ("<extended-accessor>"));
+
+ /* Primitive types classes */
+ scm_class_boolean = scm_variable_ref (scm_c_lookup ("<boolean>"));
+ scm_class_char = scm_variable_ref (scm_c_lookup ("<char>"));
+ scm_class_list = scm_variable_ref (scm_c_lookup ("<list>"));
+ scm_class_pair = scm_variable_ref (scm_c_lookup ("<pair>"));
+ scm_class_null = scm_variable_ref (scm_c_lookup ("<null>"));
+ scm_class_string = scm_variable_ref (scm_c_lookup ("<string>"));
+ scm_class_symbol = scm_variable_ref (scm_c_lookup ("<symbol>"));
+ scm_class_vector = scm_variable_ref (scm_c_lookup ("<vector>"));
+ scm_class_number = scm_variable_ref (scm_c_lookup ("<number>"));
+ scm_class_complex = scm_variable_ref (scm_c_lookup ("<complex>"));
+ scm_class_real = scm_variable_ref (scm_c_lookup ("<real>"));
+ scm_class_integer = scm_variable_ref (scm_c_lookup ("<integer>"));
+ scm_class_fraction = scm_variable_ref (scm_c_lookup ("<fraction>"));
+ scm_class_keyword = scm_variable_ref (scm_c_lookup ("<keyword>"));
+ scm_class_unknown = scm_variable_ref (scm_c_lookup ("<unknown>"));
+ scm_class_procedure = scm_variable_ref (scm_c_lookup ("<procedure>"));
+ scm_class_primitive_generic = scm_variable_ref (scm_c_lookup ("<primitive-generic>"));
+ scm_class_port = scm_variable_ref (scm_c_lookup ("<port>"));
+ scm_class_input_port = scm_variable_ref (scm_c_lookup ("<input-port>"));
+ scm_class_output_port = scm_variable_ref (scm_c_lookup ("<output-port>"));
+ scm_class_input_output_port = scm_variable_ref (scm_c_lookup ("<input-output-port>"));
+
+ scm_port_class = scm_i_port_class;
+ scm_smob_class = scm_i_smob_class;
+}
+
+SCM
+scm_get_keyword (SCM kw, SCM initargs, SCM default_value)
+{
+ scm_c_issue_deprecation_warning
+ ("scm_get_keyword is deprecated. Use `kw-arg-ref' from Scheme instead.");
+
+ return scm_call_3 (scm_variable_ref (var_get_keyword),
+ kw, initargs, default_value);
}
#define BUFFSIZE 32 /* big enough for most uses */
-#define scm_si_specializers 1 /* offset of spec. slot in a <method> */
-#define SPEC_OF(x) SCM_SLOT (x, scm_si_specializers)
+#define SPEC_OF(x) \
+ (scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("specializers"))))
+#define CPL_OF(x) \
+ (scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("cpl"))))
static SCM
scm_i_vector2list (SCM l, long len)
applicablep (SCM actual, SCM formal)
{
/* We already know that the cpl is well formed. */
- return scm_is_true (scm_c_memq (formal, SCM_SLOT (actual, scm_si_cpl)));
+ return scm_is_true (scm_c_memq (formal, CPL_OF (actual)));
}
static int
if (!scm_is_eq (SCM_CAR(s1), SCM_CAR(s2))) {
register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2);
- for (l = SCM_SLOT (targs[i], scm_si_cpl); ; l = SCM_CDR(l)) {
+ for (l = CPL_OF (targs[i]); ; l = SCM_CDR(l)) {
if (scm_is_eq (cs1, SCM_CAR (l)))
return 1;
if (scm_is_eq (cs2, SCM_CAR (l)))
gf = SCM_CAR(l); l = SCM_CDR(l);
SCM_VALIDATE_GENERIC (1, gf);
- if (scm_is_null (SCM_SLOT (gf, scm_si_methods)))
+ if (scm_is_null (scm_slot_ref (gf, scm_from_latin1_symbol ("methods"))))
SCM_MISC_ERROR ("no methods for generic ~S", scm_list_1 (gf));
return scm_compute_applicable_methods (gf, l, len - 1, 1);
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);
+}
+
\f
HCoop / bpt / guile.git / blobdiff