summaryrefslogtreecommitdiff
path: root/libguile/goops.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/goops.c')
-rw-r--r--libguile/goops.c62
1 files changed, 17 insertions, 45 deletions
diff --git a/libguile/goops.c b/libguile/goops.c
index f2ca98194..42b7a1b33 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -156,10 +156,7 @@ SCM scm_module_goops;
static SCM scm_make_unbound (void);
static SCM scm_unbound_p (SCM obj);
-static SCM scm_class_p (SCM obj);
-static SCM scm_sys_bless_applicable_struct_vtables_x (SCM applicable,
- SCM setter);
-static SCM scm_sys_make_root_class (SCM layout);
+static SCM scm_sys_make_vtable_vtable (SCM layout);
static SCM scm_sys_init_layout_x (SCM class, SCM layout);
static SCM scm_sys_clear_fields_x (SCM obj);
static SCM scm_sys_goops_early_init (void);
@@ -168,30 +165,12 @@ static SCM scm_sys_goops_loaded (void);
-SCM_DEFINE (scm_sys_make_root_class, "%make-root-class", 1, 0, 0,
+SCM_DEFINE (scm_sys_make_vtable_vtable, "%make-vtable-vtable", 1, 0, 0,
(SCM layout),
"")
-#define FUNC_NAME s_scm_sys_make_root_class
+#define FUNC_NAME s_scm_sys_make_vtable_vtable
{
- SCM z;
-
- z = scm_i_make_vtable_vtable (layout);
- SCM_SET_CLASS_FLAGS (z, (SCM_CLASSF_GOOPS_OR_VALID | SCM_CLASSF_METACLASS));
-
- return z;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_sys_bless_applicable_struct_vtables_x, "%bless-applicable-struct-vtables!", 2, 0, 0,
- (SCM applicable, SCM setter),
- "")
-#define FUNC_NAME s_scm_sys_bless_applicable_struct_vtables_x
-{
- SCM_VALIDATE_CLASS (1, applicable);
- SCM_VALIDATE_CLASS (2, setter);
- SCM_SET_VTABLE_FLAGS (applicable, SCM_VTABLE_FLAG_APPLICABLE_VTABLE);
- SCM_SET_VTABLE_FLAGS (setter, SCM_VTABLE_FLAG_SETTER_VTABLE);
- return SCM_UNSPECIFIED;
+ return scm_i_make_vtable_vtable (layout);
}
#undef FUNC_NAME
@@ -357,15 +336,6 @@ SCM_DEFINE (scm_instance_p, "instance?", 1, 0, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_class_p, "class?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} if @var{obj} is a class.")
-#define FUNC_NAME s_scm_class_p
-{
- return scm_from_bool (SCM_CLASSP (obj));
-}
-#undef FUNC_NAME
-
int
scm_is_generic (SCM x)
{
@@ -617,17 +587,6 @@ SCM_DEFINE (scm_sys_modify_class, "%modify-class", 2, 0, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_sys_invalidate_class, "%invalidate-class", 1, 0, 0,
- (SCM class),
- "")
-#define FUNC_NAME s_scm_sys_invalidate_class
-{
- SCM_VALIDATE_CLASS (1, class);
- SCM_CLEAR_CLASS_FLAGS (class, SCM_CLASSF_GOOPS_VALID);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
/* When instances change class, they finally get a new body, but
* before that, they go through purgatory in hell. Odd as it may
* seem, this data structure saves us from eternal suffering in
@@ -1143,6 +1102,19 @@ scm_init_goops_builtins (void *unused)
hell_mutex = scm_make_mutex ();
#include "libguile/goops.x"
+
+ scm_c_define ("vtable-flag-vtable",
+ scm_from_int (SCM_VTABLE_FLAG_VTABLE));
+ scm_c_define ("vtable-flag-applicable-vtable",
+ scm_from_int (SCM_VTABLE_FLAG_APPLICABLE_VTABLE));
+ scm_c_define ("vtable-flag-setter-vtable",
+ scm_from_int (SCM_VTABLE_FLAG_SETTER_VTABLE));
+ scm_c_define ("vtable-flag-validated",
+ scm_from_int (SCM_VTABLE_FLAG_VALIDATED));
+ scm_c_define ("vtable-flag-goops-class",
+ scm_from_int (SCM_VTABLE_FLAG_GOOPS_CLASS));
+ scm_c_define ("vtable-flag-goops-valid",
+ scm_from_int (SCM_VTABLE_FLAG_GOOPS_VALID));
}
void