diff options
author | Andy Wingo <wingo@pobox.com> | 2009-11-05 12:54:41 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-11-26 00:25:06 +0100 |
commit | c40944c9ff4f22ccae7c54628bf0057d9a0032f2 (patch) | |
tree | 706849ca922e7f5a2a84aef4baa520d5b41d6cb4 /module/oop | |
parent | 6d33e90f0ccf96f5a9f6403768daf24f84481046 (diff) | |
download | guile-c40944c9ff4f22ccae7c54628bf0057d9a0032f2.tar.gz |
remove code-table slot from methods
* libguile/goops.c (scm_sys_invalidate_method_cache_x, scm_make)
(create_standard_classes): Remove code-table slot from methods. The
generic cache completely does its job, afaict.
* libguile/goops.h (scm_si_formals, scm_si_body, scm_si_make_procedure):
Renumber slots.
* module/oop/goops.scm (initialize on <method>): No more code-table
slot.
* module/oop/goops/compile.scm: Always "compile" a method, instead of
looking for a hit in an always-empty cache.
Diffstat (limited to 'module/oop')
-rw-r--r-- | module/oop/goops.scm | 1 | ||||
-rw-r--r-- | module/oop/goops/compile.scm | 30 |
2 files changed, 2 insertions, 29 deletions
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 @@ -29,32 +29,6 @@ ) ;;; -;;; 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 |