mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

SCM_DEBUG fix: Don't apply SCM_CAR to non-pairs when walking argument

Browse source 
lists in method cache matching.

* libguile/goops.c (scm_mcache_lookup_cmethod): Don't apply SCM_CAR to
  non-pairs when walking argument lists in method cache matching.
  Don't check for CLASSP or symbol in the car slot, since the end of
  the specifier list is a non-pair.  Update comments to reflect new
  structure of method cache entry.
* module/oops/goops/dispatch.scm: Update comments here too.
This commit is contained in:
Ken Raeburn 2009-11-15 23:43:17 -05:00
parent d02f313714
commit 222831b443
2 changed files with 9 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

18
libguile/goops.c
View file

@ -1779,12 +1779,12 @@ SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
*
* Format #1:
* (SCM_IM_DISPATCH ARGS N-SPECIALIZED
* #((TYPE1 ... ENV FORMALS FORM ...) ...)
* #((TYPE1 ... . CMETHOD) ...)
* GF)
*
* Format #2:
* (SCM_IM_HASH_DISPATCH ARGS N-SPECIALIZED HASHSET MASK
* #((TYPE1 ... ENV FORMALS FORM ...) ...)
* #((TYPE1 ... CMETHOD) ...)
* GF)
*
* ARGS is either a list of expressions, in which case they
@ -1795,9 +1795,6 @@ SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
* SCM_IM_DISPATCH expressions in generic functions always
* have ARGS = the symbol `args' or the iloc #@0-0.
*
* Need FORMALS in order to support varying arity. This
* also avoids the need for renaming of bindings.
*
* We should probably not complicate this mechanism by
* introducing "optimizations" for getters and setters or
* primitive methods. Getters and setter will normally be
@ -1853,19 +1850,18 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
long j = n;
z = SCM_SIMPLE_VECTOR_REF (methods, i);
ls = args; /* list of arguments */
if (!scm_is_null (ls))
/* More arguments than specifiers => z = CMETHOD, not a pair.
* Fewer arguments than specifiers => CAR != CLASS or `no-method'. */
if (!scm_is_null (ls) && scm_is_pair (z))
do
{
/* More arguments than specifiers => CLASS != ENV */
if (! scm_is_eq (scm_class_of (SCM_CAR (ls)), SCM_CAR (z)))
goto next_method;
ls = SCM_CDR (ls);
z = SCM_CDR (z);
}
while (j-- && !scm_is_null (ls));
/* 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))))
while (j-- && !scm_is_null (ls) && scm_is_pair (z));
if (!scm_is_pair (z))
return z;
next_method:
i = (i + 1) & mask;

4
module/oop/goops/dispatch.scm
View file

@ -53,9 +53,9 @@
;;; Method cache
;;;
;; (#@dispatch args N-SPECIALIZED #((TYPE1 ... ENV FORMALS FORM1 ...) ...) GF)
;; (#@dispatch args N-SPECIALIZED #((TYPE1 ... . CMETHOD) ...) GF)
;; (#@dispatch args N-SPECIALIZED HASHSET MASK
;; #((TYPE1 ... ENV FORMALS FORM1 ...) ...)
;; #((TYPE1 ... . CMETHOD) ...)
;; GF)
;;; Representation