summaryrefslogtreecommitdiff
path: root/libguile/goops.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-11-20 13:11:52 +0100
committerAndy Wingo <wingo@pobox.com>2009-11-26 00:25:07 +0100
commit2f652c6884d2ae58b4177fef2f306f0312e7b347 (patch)
tree247b6bf1278ea7f3bafbf549d41d1cda8bd1b0d3 /libguile/goops.c
parent9f63ce021c567056c02b81d96742ff91416b886f (diff)
downloadguile-2f652c6884d2ae58b4177fef2f306f0312e7b347.tar.gz
generics now dispatch as applicable structs
* libguile/eval.i.c (CEVAL, SCM_APPLY): Dispatch applicable structs before pure generics. In practice what this means is that we never hit the mcache case, because all pure generics are applicable structs. We're moving over to having generics dispatch themselves. Also, they don't prepend the struct as an arg; in order to have that effect, the user has closures. * libguile/goops.c (scm_apply_generic, scm_call_generic_0): (scm_call_generic_1, scm_call_generic_2, scm_call_generic_3): Dispatch directly to the struct procedures. (scm_var_make_extended_generic): Remove a duplicate definition for scm_var_make_extended_generic. (create_standard_classes): Mark all instances of <applicable-struct-class> (themselves classes) as applicable classes. Meaning: generics are now applicable structs. * libguile/goops.h (SCM_CLASS_CLASS_LAYOUT): The hashsets are actually uw slots -- or at least, making subclasses maps the int slots to be uw slots * libguile/vm-i-system.c (call, goto/args, mv-call): Dispatch applicable structs in the VM. * module/oop/goops/dispatch.scm (emit-linear-dispatch): Fix bug in the non-rest cache miss case. (delayed-compile): Rework to avoid fluids. (cache-dispatch): Don't call `equal?', it causes bootstrapping problems with the primitive-generic equal?. Using our own version is faster anyway.
Diffstat (limited to 'libguile/goops.c')
-rw-r--r--libguile/goops.c24
1 files changed, 6 insertions, 18 deletions
diff --git a/libguile/goops.c b/libguile/goops.c
index 88408f686..4a38f397c 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1800,40 +1800,31 @@ scm_mcache_compute_cmethod (SCM cache, SCM args)
SCM
scm_apply_generic (SCM gf, SCM args)
{
- SCM cmethod = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (gf), args);
- if (SCM_PROGRAM_P (cmethod))
- return scm_vm_apply (scm_the_vm (), cmethod, args);
- else if (scm_is_pair (cmethod))
- return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)),
- SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)),
- args,
- SCM_CMETHOD_ENV (cmethod)));
- else
- return scm_apply (cmethod, args, SCM_EOL);
+ return scm_apply (SCM_STRUCT_PROCEDURE (gf), args, SCM_EOL);
}
SCM
scm_call_generic_0 (SCM gf)
{
- return scm_apply_generic (gf, SCM_EOL);
+ return scm_call_0 (SCM_STRUCT_PROCEDURE (gf));
}
SCM
scm_call_generic_1 (SCM gf, SCM a1)
{
- return scm_apply_generic (gf, scm_list_1 (a1));
+ return scm_call_1 (SCM_STRUCT_PROCEDURE (gf), a1);
}
SCM
scm_call_generic_2 (SCM gf, SCM a1, SCM a2)
{
- return scm_apply_generic (gf, scm_list_2 (a1, a2));
+ return scm_call_2 (SCM_STRUCT_PROCEDURE (gf), a1, a2);
}
SCM
scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
{
- return scm_apply_generic (gf, scm_list_3 (a1, a2, a3));
+ return scm_call_3 (SCM_STRUCT_PROCEDURE (gf), a1, a2, a3);
}
SCM
@@ -1956,8 +1947,6 @@ static const char extension_gc_hint[] = "GOOPS extension";
static t_extension *extensions = 0;
-SCM_VARIABLE (scm_var_make_extended_generic, "make-extended-generic");
-
void
scm_c_extend_primitive_generic (SCM extended, SCM extension)
{
@@ -2554,8 +2543,7 @@ create_standard_classes (void)
scm_class_class, scm_class_class, SCM_EOL);
make_stdcls (&scm_class_applicable_struct_class, "<applicable-struct-class>",
scm_class_class, scm_class_procedure_class, SCM_EOL);
- /* SCM_SET_VTABLE_FLAGS (scm_class_applicable_struct_class,
- SCM_VTABLE_FLAG_APPLICABLE_VTABLE); */
+ SCM_SET_VTABLE_FLAGS (scm_class_applicable_struct_class, SCM_VTABLE_FLAG_APPLICABLE_VTABLE);
make_stdcls (&scm_class_method, "<method>",
scm_class_class, scm_class_object, method_slots);
make_stdcls (&scm_class_accessor_method, "<accessor-method>",