diff options
author | Andy Wingo <wingo@pobox.com> | 2009-11-20 13:11:52 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-11-26 00:25:07 +0100 |
commit | 2f652c6884d2ae58b4177fef2f306f0312e7b347 (patch) | |
tree | 247b6bf1278ea7f3bafbf549d41d1cda8bd1b0d3 /libguile/vm-i-system.c | |
parent | 9f63ce021c567056c02b81d96742ff91416b886f (diff) | |
download | guile-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/vm-i-system.c')
-rw-r--r-- | libguile/vm-i-system.c | 15 |
1 files changed, 15 insertions, 0 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index df8424c3e..59a5520f7 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -761,6 +761,11 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1) APPLY_HOOK (); NEXT; } + if (SCM_STRUCTP (x) && SCM_STRUCT_APPLICABLE_P (x)) + { + sp[-nargs] = SCM_STRUCT_PROCEDURE (x); + goto vm_call; + } if (SCM_STRUCTP (x) && SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_PURE_GENERIC) { SCM args = SCM_EOL; @@ -845,6 +850,11 @@ VM_DEFINE_INSTRUCTION (54, goto_args, "goto/args", 1, -1, 1) APPLY_HOOK (); NEXT; } + if (SCM_STRUCTP (x) && SCM_STRUCT_APPLICABLE_P (x)) + { + sp[-nargs] = SCM_STRUCT_PROCEDURE (x); + goto vm_goto_args; + } if (SCM_STRUCTP (x) && SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_PURE_GENERIC) { SCM args = SCM_EOL; @@ -937,6 +947,11 @@ VM_DEFINE_INSTRUCTION (57, mv_call, "mv-call", 4, -1, 1) APPLY_HOOK (); NEXT; } + if (SCM_STRUCTP (x) && SCM_STRUCT_APPLICABLE_P (x)) + { + sp[-nargs] = SCM_STRUCT_PROCEDURE (x); + goto vm_mv_call; + } if (SCM_STRUCTP (x) && SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_PURE_GENERIC) { SCM args = SCM_EOL; |