diff options
author | Ludovic Courtès <ludo@gnu.org> | 2009-03-22 15:28:35 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2009-03-22 15:28:35 +0100 |
commit | d9e59f894e1b41958203ddda7f21f4817cfcfe37 (patch) | |
tree | f0d6b0b38ed000aabf327dba4e281c37c60f92a5 /libguile/objects.c | |
parent | f307fbcec2cbaaa95b8c861395133b519c7519cf (diff) | |
parent | 80540f391498ebb0f955db2fafb6a36ed03b7886 (diff) | |
download | guile-d9e59f894e1b41958203ddda7f21f4817cfcfe37.tar.gz |
Merge branch 'master' into boehm-demers-weiser-gc
Conflicts:
libguile/continuations.c
libguile/gc-freelist.c
libguile/gc-mark.c
libguile/symbols.c
libguile/threads.c
module/ice-9/boot-9.scm
Diffstat (limited to 'libguile/objects.c')
-rw-r--r-- | libguile/objects.c | 20 |
1 files changed, 14 insertions, 6 deletions
diff --git a/libguile/objects.c b/libguile/objects.c index 0b2c3be74..628ddaada 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -39,6 +39,8 @@ #include "libguile/ports.h" #include "libguile/strings.h" #include "libguile/vectors.h" +#include "libguile/programs.h" +#include "libguile/vm.h" #include "libguile/validate.h" #include "libguile/objects.h" @@ -138,8 +140,9 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args) z = SCM_CDR (z); } while (j-- && !scm_is_null (ls)); - /* Fewer arguments than specifiers => CAR != ENV */ - if (scm_is_null (SCM_CAR (z)) || scm_is_pair (SCM_CAR (z))) + /* Fewer arguments than specifiers => CAR != CLASS or `no-method' */ + if (!scm_is_pair (z) + || (!SCM_CLASSP (SCM_CAR (z)) && !scm_is_symbol (SCM_CAR (z)))) return z; next_method: i = (i + 1) & mask; @@ -161,10 +164,15 @@ SCM scm_apply_generic (SCM gf, SCM args) { SCM cmethod = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (gf), args); - return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)), - SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)), - args, - SCM_CMETHOD_ENV (cmethod))); + 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); } SCM |