diff --git a/libguile/goops.c b/libguile/goops.c index 0ce4a682e..1f865767a 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1911,16 +1911,11 @@ SCM_DEFINE (scm_sys_invalidate_method_cache_x, "%invalidate-method-cache!", 1, 0 "") #define FUNC_NAME s_scm_sys_invalidate_method_cache_x { - SCM methods, n; - SCM_ASSERT (SCM_PUREGENERICP (gf), gf, SCM_ARG1, FUNC_NAME); - methods = SCM_SLOT (gf, scm_si_methods); clear_method_cache (gf); - for (; scm_is_pair (methods); methods = SCM_CDR (methods)) - SCM_SET_SLOT (SCM_CAR (methods), scm_si_code_table, SCM_EOL); - n = SCM_SLOT (gf, scm_si_n_specialized); - /* The sign of n is a flag indicating rest args. */ - SCM_SET_MCACHE_N_SPECIALIZED (SCM_GENERIC_METHOD_CACHE (gf), n); + /* The sign of n-specialized is a flag indicating rest args. */ + SCM_SET_MCACHE_N_SPECIALIZED (SCM_GENERIC_METHOD_CACHE (gf), + SCM_SLOT (gf, scm_si_n_specialized)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -2397,7 +2392,6 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1, len - 1, SCM_BOOL_F, FUNC_NAME)); - SCM_SET_SLOT (z, scm_si_code_table, SCM_EOL); SCM_SET_SLOT (z, scm_si_formals, scm_i_get_keyword (k_formals, args, @@ -2558,7 +2552,6 @@ create_standard_classes (void) SCM method_slots = scm_list_n (scm_from_locale_symbol ("generic-function"), scm_from_locale_symbol ("specializers"), sym_procedure, - scm_from_locale_symbol ("code-table"), scm_from_locale_symbol ("formals"), scm_from_locale_symbol ("body"), scm_from_locale_symbol ("make-procedure"), diff --git a/libguile/goops.h b/libguile/goops.h index 1c369ea9f..8d5fdc609 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -186,10 +186,9 @@ typedef struct scm_t_method { #define scm_si_generic_function 0 /* offset of gf slot in a */ #define scm_si_specializers 1 /* offset of spec. slot in a */ #define scm_si_procedure 2 /* offset of proc. slot in a */ -#define scm_si_code_table 3 /* offset of code. slot in a */ -#define scm_si_formals 4 /* offset of form. slot in a */ -#define scm_si_body 5 /* offset of body slot in a */ -#define scm_si_make_procedure 6 /* offset of makep.slot in a */ +#define scm_si_formals 3 /* offset of form. slot in a */ +#define scm_si_body 4 /* offset of body slot in a */ +#define scm_si_make_procedure 5 /* offset of makep.slot in a */ /* C interface */ SCM_API SCM scm_class_boolean; diff --git a/module/oop/goops.scm b/module/oop/goops.scm index a9e26b5aa..b67c4d4b0 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -1517,7 +1517,6 @@ (slot-set! method 'specializers (get-keyword #:specializers initargs '())) (slot-set! method 'procedure (get-keyword #:procedure initargs #f)) - (slot-set! method 'code-table '()) (slot-set! method 'formals (get-keyword #:formals initargs '())) (slot-set! method 'body (get-keyword #:body initargs '())) (slot-set! method 'make-procedure (get-keyword #:make-procedure initargs #f))) diff --git a/module/oop/goops/compile.scm b/module/oop/goops/compile.scm index 5db406cd0..db1a16088 100644 --- a/module/oop/goops/compile.scm +++ b/module/oop/goops/compile.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006, 2009 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -28,32 +28,6 @@ :no-backtrace ) -;;; -;;; Method entries -;;; - -(define code-table-lookup - (letrec ((check-entry (lambda (entry types) - (cond - ((not (pair? entry)) (and (null? types) entry)) - ((null? types) #f) - (else - (and (eq? (car entry) (car types)) - (check-entry (cdr entry) (cdr types)))))))) - (lambda (code-table types) - (cond ((null? code-table) #f) - ((check-entry (car code-table) types)) - (else (code-table-lookup (cdr code-table) types)))))) - -(define (compute-cmethod methods types) - (or (code-table-lookup (slot-ref (car methods) 'code-table) types) - (let* ((method (car methods)) - (cmethod (compile-method methods types)) - (entry (append types cmethod))) - (slot-set! method 'code-table - (cons entry (slot-ref method 'code-table))) - cmethod))) - ;;; ;;; Compiling next methods into method bodies ;;; @@ -70,7 +44,7 @@ ;;; I think this whole generic application mess would benefit from a ;;; strict MOP. -(define (compile-method methods types) +(define (compute-cmethod methods types) (let ((make-procedure (slot-ref (car methods) 'make-procedure))) (if make-procedure (make-procedure